├── .Rbuildignore ├── .github └── workflows │ └── build_test_push.yml ├── .gitignore ├── DESCRIPTION ├── Dockerfile ├── NAMESPACE ├── R ├── AllClasses.R ├── AllGenerics.R ├── AnnotationHub.R ├── CCSParams-methods.R ├── cellCellDecomp-internal.R ├── cellCellReport-Enrichment.R ├── cellCellReport-HTML.R ├── cellCellReport-NTD.R ├── cellCellReport-NTD2.R ├── cellCellReport-internal.R ├── cellCellSimulate-internal.R ├── geneInformation.R └── scTensor-internal.R ├── README.md ├── data ├── GermMale.rda ├── labelGermMale.rda ├── m.rda ├── tsneGermMale.rda └── v.rda ├── inst ├── NEWS └── extdata │ ├── Workflow.png │ └── Workflow_2.png ├── man ├── CCSParams-class.Rd ├── GermMale.Rd ├── cellCellDecomp.Rd ├── cellCellRanks.Rd ├── cellCellReport.Rd ├── cellCellSetting.Rd ├── cellCellSimulate.Rd ├── getParam.Rd ├── labelGermMale.Rd ├── m.Rd ├── newCCSParams.Rd ├── scTensor-package.Rd ├── setParam.Rd ├── tsneGermMale.Rd └── v.Rd ├── tests ├── testthat.R └── testthat │ ├── test_CCSParamsFunctions.R │ ├── test_GermMale.R │ ├── test_cellCellFunctions.R │ ├── test_labelGermMale.R │ └── test_tsneGermMale.R └── vignettes ├── Details_115_EA_GO.jpg ├── Details_115_EA_HEADER.jpg ├── Details_115_HEADER.jpg ├── Details_115_Pair.jpg ├── Details_32_EA_HEADER.png ├── Details_32_HEADER.png ├── Details_32_Pair.png ├── Ligand_all.jpg ├── Ligand_all.png ├── Ligand_selected.jpg ├── Ligand_selected.png ├── Mode1.jpg ├── Mode2.jpg ├── Mode3.jpg ├── Mode3Sum.jpg ├── Receptor_all.jpg ├── Receptor_all.png ├── Receptor_all_HEADER.jpg ├── Receptor_all_HEADER.png ├── Receptor_selected.jpg ├── Receptor_selected.png ├── Report.jpeg ├── Report.png ├── Report5_Zoom.jpg ├── Report_1.jpg ├── Report_1.png ├── Report_2.jpg ├── Report_2_1.jpg ├── Report_2_2.jpg ├── Report_2_3.jpg ├── Report_2_4.jpg ├── Report_2_4.png ├── Report_2_5.jpg ├── Report_2_6.jpg ├── Report_2_7.jpg ├── Report_3.jpg ├── Report_4.jpg ├── Report_5.jpg ├── Report_5.png ├── Report_6.jpg ├── Report_6.png ├── Report_7.jpg ├── Report_7.png ├── Report_8.jpg ├── Report_HEADER.jpg ├── Report_HEADER.png ├── Workflow.png ├── Workflow_2.png ├── scTensor.Rmd ├── scTensor_1_Data_format_ID_Conversion.Rmd ├── scTensor_2_Report_Interpretation.Rmd ├── scTensor_3_CCI_Simulation.Rmd └── scTensor_4_Reanalysis.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\.github$ 2 | ^\.git$ 3 | ^.*\.Rproj$ 4 | ^\.Rproj\.user$ 5 | ^LICENSE\.md$ 6 | ^README\.md$ 7 | ^cran-comments\.md$ 8 | ^CRAN-SUBMISSION$ 9 | ^.*\.Rhistory$ 10 | ^Dockerfile$ -------------------------------------------------------------------------------- /.github/workflows/build_test_push.yml: -------------------------------------------------------------------------------- 1 | name: DockerHub/GHCR 2 | 3 | env: 4 | IMAGE_NAME: sctensor 5 | repo-name: koki/sctensor 6 | 7 | on: 8 | push: 9 | branches: [ master ] 10 | pull_request: 11 | branches: [ master ] 12 | workflow_dispatch: 13 | 14 | jobs: 15 | build_push_test: 16 | runs-on: ubuntu-latest 17 | steps: 18 | - name: checkout 19 | uses: actions/checkout@v2 20 | 21 | - name: Login to GitHub Container Registry 22 | uses: docker/login-action@v1 23 | with: 24 | registry: ghcr.io 25 | username: ${{ github.actor }} 26 | password: ${{ secrets.GITHUB_TOKEN }} 27 | 28 | - name: Declare some variables 29 | id: vars 30 | shell: bash 31 | run: | 32 | echo "::set-output name=sha_short::$(git rev-parse --short HEAD)" 33 | 34 | - name: Build 35 | run: docker build -t ${{ github.repository_owner }}/${{ env.IMAGE_NAME }} . 36 | 37 | - name: Tag (Latest) 38 | run: docker tag ${{ github.repository_owner }}/${{ env.IMAGE_NAME }} ghcr.io/${{ github.repository_owner }}/${{ env.IMAGE_NAME }} 39 | 40 | - name: Tag (SHA) 41 | run: docker tag ghcr.io/${{ github.repository_owner }}/${{ env.IMAGE_NAME }}:latest ghcr.io/${{ github.repository_owner }}/${{ env.IMAGE_NAME }}:${{ steps.vars.outputs.sha_short }} 42 | 43 | - name: Push (Latest) 44 | run: docker push ghcr.io/${{ github.repository_owner }}/${{ env.IMAGE_NAME }}:latest 45 | 46 | - name: Push (SHA) 47 | run: docker push ghcr.io/${{ github.repository_owner }}/${{ env.IMAGE_NAME }}:${{ steps.vars.outputs.sha_short }} 48 | 49 | - uses: docker/build-push-action@v1 50 | with: 51 | # The two entries below need to be entered as 52 | # github secrets. The "secret" names are "DOCKER_USERNAME" 53 | # and "DOCKER_PASSWORD". See https://docs.github.com/en/actions/reference/encrypted-secrets#creating-encrypted-secrets-for-a-repository 54 | # for detailed instructions. 55 | # 56 | # DO NOT EDIT THESE ENTRIES HERE. Doing so will 57 | # expose your docker username and password on github. 58 | username: ${{ secrets.DOCKER_USERNAME }} 59 | password: ${{ secrets.DOCKER_PASSWORD }} 60 | # Use the environment variable on first few lines to set repo name--just centralizes changes 61 | repository: ${{ env.repo-name }} 62 | tag_with_ref: true 63 | tag_with_sha: true 64 | tags: latest 65 | 66 | # Ref 67 | # https://github.com/marketplace/actions/docker-login 68 | # https://github.com/inutano/cwl-log-generator/blob/master/.github/workflows/main.yml 69 | # https://www.docker.com/blog/first-docker-github-action-is-here/ 70 | # https://github.com/docker/login-action 71 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ################# 2 | ## Eclipse 3 | ################# 4 | 5 | *.pydevproject 6 | .project 7 | .metadata 8 | bin/ 9 | tmp/ 10 | *.tmp 11 | *.bak 12 | *.swp 13 | *~.nib 14 | local.properties 15 | .classpath 16 | .settings/ 17 | .loadpath 18 | 19 | # External tool builders 20 | .externalToolBuilders/ 21 | 22 | # Locally stored "Eclipse launch configurations" 23 | *.launch 24 | 25 | # CDT-specific 26 | .cproject 27 | 28 | # PDT-specific 29 | .buildpath 30 | 31 | 32 | ################# 33 | ## Visual Studio 34 | ################# 35 | 36 | ## Ignore Visual Studio temporary files, build results, and 37 | ## files generated by popular Visual Studio add-ons. 38 | 39 | # User-specific files 40 | *.suo 41 | *.user 42 | *.sln.docstates 43 | 44 | # Build results 45 | 46 | [Dd]ebug/ 47 | [Rr]elease/ 48 | x64/ 49 | build/ 50 | [Bb]in/ 51 | [Oo]bj/ 52 | 53 | # MSTest test Results 54 | [Tt]est[Rr]esult*/ 55 | [Bb]uild[Ll]og.* 56 | 57 | *_i.c 58 | *_p.c 59 | *.ilk 60 | *.meta 61 | *.obj 62 | *.pch 63 | *.pdb 64 | *.pgc 65 | *.pgd 66 | *.rsp 67 | *.sbr 68 | *.tlb 69 | *.tli 70 | *.tlh 71 | *.tmp 72 | *.tmp_proj 73 | *.log 74 | *.vspscc 75 | *.vssscc 76 | .builds 77 | *.pidb 78 | *.log 79 | *.scc 80 | 81 | # Visual C++ cache files 82 | ipch/ 83 | *.aps 84 | *.ncb 85 | *.opensdf 86 | *.sdf 87 | *.cachefile 88 | 89 | # Visual Studio profiler 90 | *.psess 91 | *.vsp 92 | *.vspx 93 | 94 | # Guidance Automation Toolkit 95 | *.gpState 96 | 97 | # ReSharper is a .NET coding add-in 98 | _ReSharper*/ 99 | *.[Rr]e[Ss]harper 100 | 101 | # TeamCity is a build add-in 102 | _TeamCity* 103 | 104 | # DotCover is a Code Coverage Tool 105 | *.dotCover 106 | 107 | # NCrunch 108 | *.ncrunch* 109 | .*crunch*.local.xml 110 | 111 | # Installshield output folder 112 | [Ee]xpress/ 113 | 114 | # DocProject is a documentation generator add-in 115 | DocProject/buildhelp/ 116 | DocProject/Help/*.HxT 117 | DocProject/Help/*.HxC 118 | DocProject/Help/*.hhc 119 | DocProject/Help/*.hhk 120 | DocProject/Help/*.hhp 121 | DocProject/Help/Html2 122 | DocProject/Help/html 123 | 124 | # Click-Once directory 125 | publish/ 126 | 127 | # Publish Web Output 128 | *.Publish.xml 129 | *.pubxml 130 | 131 | # NuGet Packages Directory 132 | ## TODO: If you have NuGet Package Restore enabled, uncomment the next line 133 | #packages/ 134 | 135 | # Windows Azure Build Output 136 | csx 137 | *.build.csdef 138 | 139 | # Windows Store app package directory 140 | AppPackages/ 141 | 142 | # Others 143 | sql/ 144 | *.Cache 145 | ClientBin/ 146 | [Ss]tyle[Cc]op.* 147 | ~$* 148 | *~ 149 | *.dbmdl 150 | *.[Pp]ublish.xml 151 | *.pfx 152 | *.publishsettings 153 | 154 | # RIA/Silverlight projects 155 | Generated_Code/ 156 | 157 | # Backup & report files from converting an old project file to a newer 158 | # Visual Studio version. Backup files are not needed, because we have git ;-) 159 | _UpgradeReport_Files/ 160 | Backup*/ 161 | UpgradeLog*.XML 162 | UpgradeLog*.htm 163 | 164 | # SQL Server files 165 | App_Data/*.mdf 166 | App_Data/*.ldf 167 | 168 | ############# 169 | ## Windows detritus 170 | ############# 171 | 172 | # Windows image file caches 173 | Thumbs.db 174 | ehthumbs.db 175 | 176 | # Folder config file 177 | Desktop.ini 178 | 179 | # Recycle Bin used on file shares 180 | $RECYCLE.BIN/ 181 | 182 | # Mac crap 183 | .DS_Store 184 | 185 | # sshfs 186 | .fuse* 187 | 188 | .Rhistory 189 | */.Rhistory 190 | */*.Rhistory 191 | */*/*.Rhistory 192 | */*/*/*.Rhistory 193 | 194 | ############# 195 | ## Python 196 | ############# 197 | 198 | *.py[co] 199 | 200 | # Packages 201 | *.egg 202 | *.egg-info 203 | dist/ 204 | build/ 205 | eggs/ 206 | parts/ 207 | var/ 208 | sdist/ 209 | develop-eggs/ 210 | .installed.cfg 211 | 212 | # Installer logs 213 | pip-log.txt 214 | 215 | # Unit test / coverage reports 216 | .coverage 217 | .tox 218 | 219 | #Translations 220 | *.mo 221 | 222 | #Mr Developer 223 | .mr.developer.cfg 224 | # C++ 225 | # Compiled Object files 226 | *.slo 227 | *.lo 228 | *.o 229 | *.obj 230 | # Precompiled Headers 231 | *.gch 232 | *.pch 233 | # Compiled Dynamic libraries 234 | *.so 235 | *.dylib 236 | *.dll 237 | # Fortran module files 238 | *.mod 239 | # Compiled Static libraries 240 | *.lai 241 | *.la 242 | *.a 243 | *.lib 244 | # Executables 245 | *.exe 246 | *.out 247 | *.app 248 | 249 | # C 250 | # Object files 251 | *.o 252 | *.ko 253 | *.obj 254 | *.elf 255 | # Precompiled Headers 256 | *.gch 257 | *.pch 258 | # Libraries 259 | *.lib 260 | *.a 261 | *.la 262 | *.lo 263 | # Shared objects (inc. Windows DLLs) 264 | *.dll 265 | *.so 266 | *.so.* 267 | *.dylib 268 | # Executables 269 | *.exe 270 | *.out 271 | *.app 272 | *.i*86 273 | *.x86_64 274 | *.hex 275 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: scTensor 2 | Type: Package 3 | Title: Detection of cell-cell interaction from single-cell RNA-seq dataset by tensor decomposition 4 | Version: 2.18.1 5 | Authors@R: c(person("Koki", "Tsuyuzaki", role = c("aut", "cre"), 6 | email = "k.t.the-answer@hotmail.co.jp"), 7 | person("Kozo", "Nishida", role = "aut", 8 | email = "kozo.nishida@gmail.com")) 9 | Depends: R (>= 4.1.0) 10 | Imports: methods, 11 | RSQLite, 12 | igraph, 13 | S4Vectors, 14 | plotly, 15 | reactome.db, 16 | AnnotationDbi, 17 | SummarizedExperiment, 18 | SingleCellExperiment, 19 | nnTensor (>= 1.1.5), 20 | ccTensor (>= 1.0.2), 21 | rTensor (>= 1.4.8), 22 | abind, 23 | plotrix, 24 | heatmaply, 25 | tagcloud, 26 | rmarkdown, 27 | BiocStyle, 28 | knitr, 29 | AnnotationHub, 30 | MeSHDbi (>= 1.29.2), 31 | grDevices, 32 | graphics, 33 | stats, 34 | utils, 35 | outliers, 36 | Category, 37 | meshr (>= 1.99.1), 38 | GOstats, 39 | ReactomePA, 40 | DOSE, 41 | crayon, 42 | checkmate, 43 | BiocManager, 44 | visNetwork, 45 | schex, 46 | ggplot2 47 | Suggests: testthat, 48 | LRBaseDbi, 49 | Seurat, 50 | scTGIF, 51 | Homo.sapiens 52 | Description: The algorithm is based on the non-negative tucker decomposition (NTD2) of nnTensor. 53 | License: Artistic-2.0 54 | biocViews: DimensionReduction, 55 | SingleCell, 56 | Software, 57 | GeneExpression 58 | VignetteBuilder: knitr -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | # Base Image 2 | FROM bioconductor/bioconductor_docker:devel 3 | 4 | # Install R Packages 5 | RUN R -e "devtools::install_github('rikenbit/scTensor', \ 6 | upgrade='always', force=TRUE, INSTALL_opts = '--install-tests');\ 7 | tools::testInstalledPackage('scTensor')" 8 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | import(methods) 2 | import(SingleCellExperiment) 3 | import(BiocStyle) 4 | import(knitr) 5 | import(RSQLite) 6 | import(AnnotationHub) 7 | 8 | importFrom(BiocManager, install) 9 | importFrom(AnnotationDbi, toTable) 10 | importFrom(igraph, graph.data.frame, bipartite_mapping, max_bipartite_match, graph.empty, add.vertices, add.edges, "E<-", "V<-", V, E, layout_with_dh, plot.igraph, get.edgelist, get.vertex.attribute, edge.attributes) 11 | importFrom(reactome.db, reactomeEXTID2PATHID) 12 | importFrom(MeSHDbi, select) 13 | importFrom(S4Vectors, metadata, "metadata<-") 14 | importFrom(plotly, plot_ly) 15 | importFrom(SummarizedExperiment, assay, assays, "assay<-", "assays<-") 16 | importFrom(rTensor, as.tensor, modeSum, rs_unfold, cs_unfold) 17 | importFrom(abind, abind) 18 | importFrom(plotrix, gradient.rect) 19 | importFrom(heatmaply, heatmaply) 20 | importFrom(tagcloud, smoothPalette, tagcloud) 21 | importFrom(rmarkdown, render) 22 | 23 | importFrom(grDevices, colorRampPalette, dev.off, png, rgb) 24 | importFrom(graphics, par, plot, text, legend) 25 | importFrom(utils, browseURL, txtProgressBar, setTxtProgressBar) 26 | importFrom(outliers, grubbs.test, chisq.out.test) 27 | importFrom(nnTensor, NMF, NTD, recTensor) 28 | importFrom(ccTensor, MultiCX) 29 | importFrom(Category, hyperGTest) 30 | 31 | importFrom(meshr, meshHyperGTest) 32 | import(GOstats) 33 | importFrom(ReactomePA, enrichPathway) 34 | importFrom(DOSE, enrichDGN, enrichDO, enrichNCG) 35 | 36 | importFrom(crayon, bold, blue, green) 37 | importFrom(checkmate, assertClass, assertList) 38 | importFrom(stats, median, cor, dist, na.omit, quantile, p.adjust, hclust, cutree, rbinom, rnbinom, var, sd) 39 | importFrom("utils", "data") 40 | importFrom("grDevices", "hcl") 41 | 42 | importFrom(visNetwork, visNetwork) 43 | importFrom(schex, make_hexbin, plot_hexbin_feature) 44 | importFrom(ggplot2, scale_fill_gradient, ggsave) 45 | 46 | exportMethods(cellCellSetting, cellCellRanks, cellCellDecomp, cellCellReport, getParam, "setParam<-") 47 | export(cellCellSimulate, newCCSParams) -------------------------------------------------------------------------------- /R/AllClasses.R: -------------------------------------------------------------------------------- 1 | setClass("CCSParams", 2 | slots = c( 3 | nGene = "numeric", 4 | nCell = "numeric", 5 | cciInfo = "list", 6 | lambda = "numeric", 7 | seed = "numeric" 8 | ), 9 | prototype = prototype( 10 | nGene=1000, 11 | nCell=c(50, 50, 50), 12 | cciInfo=list( 13 | nPair=500, 14 | CCI1=list( 15 | LPattern=c(1,0,0), 16 | RPattern=c(0,1,0), 17 | nGene=50, 18 | fc="E10"), 19 | CCI2=list( 20 | LPattern=c(0,1,0), 21 | RPattern=c(0,0,1), 22 | nGene=50, 23 | fc="E10"), 24 | CCI3=list( 25 | LPattern=c(0,0,1), 26 | RPattern=c(1,0,0), 27 | nGene=50, 28 | fc="E10") 29 | ), 30 | lambda = 1, 31 | seed = 1234 32 | ) 33 | ) 34 | -------------------------------------------------------------------------------- /R/AllGenerics.R: -------------------------------------------------------------------------------- 1 | # 2 | # cellCellSetting 3 | # 4 | setGeneric("cellCellSetting", function(sce, lrbase, label, lr.evidence="known", color=NULL){ 5 | standardGeneric("cellCellSetting")}) 6 | 7 | setMethod("cellCellSetting", signature(sce="SingleCellExperiment"), 8 | function(sce, lrbase, label, lr.evidence="known", color=NULL){ 9 | userobjects <- deparse(substitute(sce)) 10 | .cellCellSetting(userobjects, lrbase, label, lr.evidence, color, sce)}) 11 | 12 | .cellCellSetting <- function(userobjects, lrbase, label, lr.evidence, color, ...){ 13 | sce <- list(...)[[1]] 14 | # class-check 15 | if(is(lrbase)[1] != "LRBaseDb"){ 16 | stop("Please specify the lrbase as LRBaseDbi-class object 17 | such as LRBase.Hsa.eg.db") 18 | } 19 | # size-check 20 | if(length(label) != ncol(assay(sce))){ 21 | stop("Please specify the label as the vector which has 22 | same length of nrow(assay(sce))") 23 | } 24 | if(is.null(color)){ 25 | unique.label <- unique(label) 26 | base.color <- .ggdefault_cols(length(unique.label)) 27 | color <- label 28 | for(i in seq_along(base.color)){ 29 | color[which(color == unique.label[i])] <- base.color[i] 30 | } 31 | } 32 | 33 | # size-check 34 | if(length(color) != ncol(assay(sce))){ 35 | stop("Please specify the color as the vector which has 36 | same length of nrow(assay(sce))") 37 | } 38 | # size-check 39 | if(length(unique(color)) != length(unique(label))){ 40 | stop("Please specify the kind of elements containing 41 | in color and label as same") 42 | } 43 | 44 | # Rowname-check 45 | rn <- rownames(assay(sce)) 46 | if(length(rn) != length(unique(rn))){ 47 | stop("Please specify the row names of the input matrix is unique") 48 | } 49 | # Only matrix is accepted 50 | for(i in names(assays(sce))){ 51 | if(!is.matrix(assays(sce)[[i]])){ 52 | message("The input data is coverted to matrix format by as.matrix") 53 | assays(sce)[[i]] <- as.matrix(assays(sce)[[i]]) 54 | } 55 | } 56 | # NA-check 57 | NA1 <- length(which(is.na(colnames(assay(sce))))) 58 | NA2 <- length(which(is.na(label))) 59 | NA3 <- length(which(is.na(color))) 60 | if(NA1 != 0){ 61 | stop("At least one NA element is in colnames(assay(sce))\nPlease remove it.") 62 | } 63 | if(NA2 != 0){ 64 | stop("At least one NA element is in label\nPlease remove it.") 65 | } 66 | if(NA3 != 0){ 67 | stop("At least one NA element is in color\nPlease remove it.") 68 | } 69 | # Overwrite 70 | metadata(sce) <- list(lrbase=lrbase$conn@dbname, 71 | ahid=names(lrbase$dbfile), 72 | lr.evidence=lr.evidence, label=label, color=color) 73 | assign(userobjects, sce, envir=.GlobalEnv) 74 | } 75 | 76 | # 77 | # cellCellRanks 78 | # 79 | setGeneric("cellCellRanks", function(sce, centering=TRUE, 80 | mergeas=c("mean", "sum"), outerfunc=c("*", "+"), comb=c("random", "all"), 81 | num.sampling=100, num.perm=1000, assayNames="counts", verbose=FALSE, 82 | num.iter1=5, num.iter2=5, num.iter3=NULL){ 83 | standardGeneric("cellCellRanks")}) 84 | 85 | setMethod("cellCellRanks", 86 | signature(sce="SingleCellExperiment"), 87 | function(sce, centering=TRUE, 88 | mergeas=c("mean", "sum"), outerfunc=c("*", "+"), comb=c("random", "all"), 89 | num.sampling=100, num.perm=1000, assayNames="counts", verbose=FALSE, 90 | num.iter1=5, num.iter2=5, num.iter3=NULL){ 91 | # Argument Check 92 | mergeas <- match.arg(mergeas) 93 | outerfunc <- match.arg(outerfunc) 94 | comb <- match.arg(comb) 95 | .cellCellRanks(centering, mergeas, outerfunc, comb, num.sampling, num.perm, 96 | assayNames, verbose, num.iter1, num.iter2, num.iter3, sce) 97 | }) 98 | 99 | .cellCellRanks <- function(centering, mergeas, outerfunc, comb, num.sampling, num.perm, 100 | assayNames, verbose, num.iter1, num.iter2, num.iter3, ...){ 101 | # value-check 102 | if(num.iter1 < 0){ 103 | stop("Please specify the num.iter1 as positive integer") 104 | } 105 | if(num.iter2 < 0){ 106 | stop("Please specify the num.iter2 as positive integer") 107 | } 108 | # Import from sce object 109 | sce <- list(...)[[1]] 110 | # Import expression matrix 111 | input <- .importAssays(sce, assayNames) 112 | lr.evidence <- metadata(sce)$lr.evidence 113 | LR <- .extractLR(sce, lr.evidence, c("GENEID_L", "GENEID_R")) 114 | celltypes <- metadata(sce)$color 115 | names(celltypes) <- metadata(sce)$label 116 | l <- length(unique(celltypes)) 117 | # Tensor is generated 118 | tnsr <- .cellCellDecomp.Third(input, LR, celltypes, ranks=c(1,1,1), 119 | rank=1, centering, mergeas, outerfunc, comb, num.sampling, 120 | num.perm, decomp=FALSE, thr1=log2(5), thr2=25, thr3=0.95, verbose)$cellcelllrpairpattern 121 | # Limit 122 | l1 <- min(dim(tnsr)[1], dim(tnsr)[2]*dim(tnsr)[3]) 123 | l2 <- min(dim(tnsr)[2], dim(tnsr)[3]*dim(tnsr)[1]) 124 | 125 | # NMF in matricised tensors in each mode 126 | out1 <- NMF(cs_unfold(tnsr, m=1)@data, runtime=num.iter1, rank.method="rss", J=1:l1) 127 | out2 <- NMF(cs_unfold(tnsr, m=2)@data, runtime=num.iter2, rank.method="rss", J=1:l2) 128 | 129 | # Reconsturction Error 130 | rss1 <- unlist(lapply(seq(l1), function(x, out1){ 131 | eval(parse(text=paste0("mean(out1$Trial$Rank", x, "$original)"))) 132 | }, out1=out1)) 133 | rss2 <- unlist(lapply(seq(l2), function(x, out2){ 134 | eval(parse(text=paste0("mean(out2$Trial$Rank", x, "$original)"))) 135 | }, out2=out2)) 136 | 137 | # Estimated rank 138 | rank1 <- min(which((max(rss1) - rss1) / (max(rss1) - min(rss1)) > 0.8)) 139 | rank2 <- min(which((max(rss2) - rss2) / (max(rss2) - min(rss2)) > 0.8)) 140 | 141 | if(!is.null(num.iter3)){ 142 | # Limit 143 | l3 <- min(30, dim(tnsr)[3], dim(tnsr)[1]*dim(tnsr)[2]) 144 | # NMF in matricised tensors in each mode 145 | out3 <- NMF(cs_unfold(tnsr, m=3)@data, runtime=num.iter3, rank.method="rss", J=1:l3) 146 | # Reconsturction Error 147 | rss3 <- unlist(lapply(seq(l3), function(x, out3){ 148 | eval(parse(text=paste0("mean(out3$Trial$Rank", x, "$original)"))) 149 | }, out3=out3)) 150 | # Estimated rank 151 | rank3 <- min(which((max(rss3) - rss3) / (max(rss3) - min(rss3)) > 0.8)) 152 | list( 153 | RSS=list( 154 | rss1=rss1, 155 | rss2=rss2, 156 | rss3=rss3), 157 | selected=c(rank1, rank2, rank3)) 158 | }else{ 159 | list(RSS=list( 160 | rss1=rss1, 161 | rss2=rss2), 162 | selected=c(rank1, rank2)) 163 | } 164 | } 165 | 166 | # 167 | # cellCellDecomp 168 | # 169 | setGeneric("cellCellDecomp", function(sce, 170 | algorithm=c("ntd2", "ntd", "nmf", "cx", "pearson", 171 | "spearman", "distance", "pearson.lr", "spearman.lr", "distance.lr", 172 | "pcomb", "label.permutation", "cabello.aguilar", "halpern"), ranks=c(3,3), 173 | rank=3, thr1=log2(5), thr2=25, thr3=0.95, L1_A=0, L2_A=0, verbose=FALSE, 174 | centering=TRUE, mergeas=c("mean", "sum"), outerfunc=c("*", "+"), 175 | comb=c("random", "all"), num.sampling=100, num.perm=1000, 176 | assayNames="counts", decomp=TRUE){ 177 | standardGeneric("cellCellDecomp")}) 178 | 179 | setMethod("cellCellDecomp", signature(sce="SingleCellExperiment"), 180 | function(sce, 181 | algorithm=c("ntd2", "ntd", "nmf", "cx", "pearson", "spearman", 182 | "distance", "pearson.lr", "spearman.lr", "distance.lr", "pcomb", 183 | "label.permutation", "cabello.aguilar", "halpern"), ranks=c(3,3), 184 | rank=3, thr1=log2(5), thr2=25, thr3=0.95, L1_A=0, L2_A=0, 185 | verbose=FALSE, centering=TRUE, mergeas=c("mean", "sum"), 186 | outerfunc=c("*", "+"), comb=c("random", "all"), 187 | num.sampling=100, num.perm=1000, assayNames="counts", decomp=TRUE){ 188 | # Argument Check 189 | algorithm = match.arg(algorithm) 190 | mergeas = match.arg(mergeas) 191 | outerfunc = match.arg(outerfunc) 192 | comb = match.arg(comb) 193 | 194 | userobjects <- deparse(substitute(sce)) 195 | .cellCellDecomp(userobjects, algorithm, ranks, rank, 196 | thr1, thr2, thr3, L1_A, L2_A, verbose, centering, mergeas, 197 | outerfunc, comb, num.sampling, 198 | num.perm, assayNames, decomp, sce)}) 199 | 200 | .cellCellDecomp <- function(userobjects, algorithm, ranks, rank, 201 | thr1, thr2, thr3, L1_A, L2_A, verbose, centering, mergeas, outerfunc, 202 | comb, num.sampling, num.perm, assayNames, decomp, ...){ 203 | # Import from sce object 204 | sce <- list(...)[[1]] 205 | # Import expression matrix 206 | input <- .importAssays(sce, assayNames) 207 | lr.evidence <- metadata(sce)$lr.evidence 208 | LR <- .extractLR(sce, lr.evidence, c("GENEID_L", "GENEID_R")) 209 | celltypes <- metadata(sce)$color 210 | names(celltypes) <- metadata(sce)$label 211 | 212 | # Gene Symbol-check 213 | genesymbols <- grep("^[A-Z]", rownames(input)) 214 | if(length(genesymbols) != 0){ 215 | message(paste0("Input data matrix may contains ", 216 | length(genesymbols), 217 | " gene symbols because the name contains some alphabets.\n", 218 | "scTensor uses only NCBI Gene IDs for now.\n", 219 | "Here, the gene symbols are removed and remaining ", 220 | nrow(input) - length(genesymbols), 221 | " NCBI Gene IDs are used for scTensor next step." 222 | )) 223 | input <- input[setdiff(seq_len(nrow(input)), genesymbols), ] 224 | } 225 | # thr-check 226 | if(comb == "random" && (num.sampling <= 0)){ 227 | warning("None of cell-cell interaction will be detected.") 228 | } 229 | # Corresponding function of the algorithm 230 | f <- .flist[[algorithm]] 231 | if(is.null(f)){ 232 | stop("Please specify the appropriate algorithm\n") 233 | }else{ 234 | res.sctensor <- f(input, LR, celltypes, ranks, rank, centering, 235 | mergeas, outerfunc, comb, num.sampling, num.perm, decomp, 236 | thr1, thr2, thr3, L1_A, L2_A, verbose) 237 | } 238 | 239 | # Data size 240 | if (algorithm %in% c("cx", "ntd2", "ntd")){ 241 | datasize <- c(ncol(res.sctensor[[2]]), ncol(res.sctensor[[3]]), 242 | ncol(res.sctensor[[4]])) 243 | recerror <- res.sctensor$recerror 244 | relchange <- res.sctensor$relchange 245 | }else{ 246 | datasize <- NULL 247 | recerror <- NULL 248 | relchange <- NULL 249 | } 250 | 251 | # Overwrite 252 | metadata(sce) <- list(lrbase=metadata(sce)$lrbase, 253 | ahid=metadata(sce)$ahid, 254 | lr.evidence=metadata(sce)$lr.evidence, 255 | color=metadata(sce)$color, label=metadata(sce)$label, 256 | algorithm=algorithm, sctensor=res.sctensor, ranks=ranks, 257 | datasize=datasize, recerror=recerror, relchange=relchange) 258 | assign(userobjects, sce, envir=.GlobalEnv) 259 | } 260 | 261 | # 262 | # cellCellReport 263 | # 264 | setGeneric("cellCellReport", function(sce, reducedDimNames, 265 | out.dir=tempdir(), html.open=FALSE, 266 | title="The result of scTensor", 267 | author="The person who runs this script", assayNames="counts", thr=100, 268 | top="full", p=0.05, upper=20, 269 | goenrich=TRUE, meshenrich=TRUE, reactomeenrich=TRUE, 270 | doenrich=TRUE, ncgenrich=TRUE, dgnenrich=TRUE, nbins=40){ 271 | standardGeneric("cellCellReport")}) 272 | 273 | setMethod("cellCellReport", signature(sce="SingleCellExperiment"), 274 | function(sce, reducedDimNames, out.dir, html.open, title, author, 275 | assayNames, thr, top, p, upper, goenrich, meshenrich, 276 | reactomeenrich, doenrich, ncgenrich, dgnenrich, nbins){ 277 | .cellCellReport(reducedDimNames, out.dir, 278 | html.open, title, author, assayNames, thr, top, p, upper, 279 | goenrich, meshenrich, reactomeenrich, 280 | doenrich, ncgenrich, dgnenrich, nbins, sce)}) 281 | 282 | .cellCellReport <- function(reducedDimNames, 283 | out.dir=tempdir(), html.open=FALSE, 284 | title="The result of scTensor", 285 | author="The person who runs this script", assayNames="counts", 286 | thr=100, top="full", p=0.05, upper=20, 287 | goenrich=TRUE, meshenrich=TRUE, reactomeenrich=TRUE, 288 | doenrich=TRUE, ncgenrich=TRUE, dgnenrich=TRUE, nbins=40, ...){ 289 | # Import from sce object 290 | sce <- list(...)[[1]] 291 | # algorithm-check 292 | if(metadata(sce)$algorithm %ni% c("cx", "ntd2", "ntd")){ 293 | stop(paste0("cellCellReport can be performed by the result of", 294 | " cellCellDecomp in which the algorithm is ", 295 | "specified as 'cx', 'ntd2' or 'ntd' for now.")) 296 | } 297 | # The Directory for saving the analytical result 298 | dir.create(paste0(out.dir, "/figures"), 299 | showWarnings = FALSE, recursive = TRUE) 300 | dir.create(paste0(out.dir, "/figures/Ligand"), 301 | showWarnings = FALSE, recursive = TRUE) 302 | dir.create(paste0(out.dir, "/figures/Receptor"), 303 | showWarnings = FALSE, recursive = TRUE) 304 | dir.create(paste0(out.dir, "/figures/Tagcloud"), 305 | showWarnings = FALSE, recursive = TRUE) 306 | # File copy 307 | if(metadata(sce)$algorithm == "ntd"){ 308 | file.copy( 309 | from = system.file("extdata", "Workflow.png", package = "scTensor"), 310 | to = paste0(out.dir, "/Workflow.png"), 311 | overwrite = TRUE) 312 | } 313 | if(metadata(sce)$algorithm %in% c("cx", "ntd2")){ 314 | file.copy( 315 | from = system.file("extdata", "Workflow_2.png", package = "scTensor"), 316 | to = paste0(out.dir, "/Workflow_2.png"), 317 | overwrite = TRUE) 318 | } 319 | 320 | # HTML Report 321 | if(metadata(sce)$algorithm == "ntd"){ 322 | .cellCellReport.Third(sce, thr, upper, assayNames, reducedDimNames, out.dir, author, title, p, top, 323 | goenrich, meshenrich, reactomeenrich, 324 | doenrich, ncgenrich, dgnenrich, nbins) 325 | } 326 | if(metadata(sce)$algorithm %in% c("cx", "ntd2")){ 327 | .cellCellReport.Third_2(sce, thr, upper, assayNames, reducedDimNames, out.dir, author, title, p, top, 328 | goenrich, meshenrich, reactomeenrich, 329 | doenrich, ncgenrich, dgnenrich, nbins) 330 | } 331 | # HTML Open 332 | message(paste0("################################################\n", 333 | "Data files are saved in\n", 334 | out.dir, "\n################################################\n")) 335 | if(html.open){ 336 | browseURL(paste0(out.dir, "/index.html")) 337 | } 338 | } 339 | 340 | # 341 | # cellCellSimulate-related functions 342 | # 343 | setGeneric("getParam", function(object, name){ 344 | standardGeneric("getParam")}) 345 | setGeneric("setParam<-", function(object, name, value){ 346 | standardGeneric("setParam<-")}) 347 | setGeneric("show", function(object){ 348 | standardGeneric("show")}) 349 | 350 | # 351 | # cellCellSimulate 352 | # 353 | cellCellSimulate <- function(params = newCCSParams(), verbose = TRUE){ 354 | # Class Check 355 | assertClass(params, classes = "CCSParams") 356 | # Get the parameters 357 | if(verbose){message("Getting the values of params...")} 358 | nGene <- getParam(params, "nGene") 359 | nCell <- getParam(params, "nCell") 360 | cciInfo <- getParam(params, "cciInfo") 361 | lambda <- getParam(params, "lambda") 362 | # Set random seed 363 | if(verbose){message("Setting random seed...")} 364 | seed <- getParam(params, "seed") 365 | # Simulation data 366 | if(verbose){message("Generating simulation data...")} 367 | # Generate Simulation data 368 | out <- .simulateDropoutCounts(nGene, nCell, cciInfo, lambda, seed) 369 | input <- out$simcount 370 | LR <- out$LR 371 | celltypes <- out$celltypes 372 | LR_CCI <- out$LR_CCI 373 | # Output 374 | if(verbose){message("Done!")} 375 | list(input=input, LR=LR, celltypes=celltypes, LR_CCI=LR_CCI) 376 | } 377 | -------------------------------------------------------------------------------- /R/AnnotationHub.R: -------------------------------------------------------------------------------- 1 | .annotationhub_taxid <- function(taxid){ 2 | ################################### 3 | # OrgDb Search 4 | ################################### 5 | ahub <- AnnotationHub() 6 | target1 <- which(mcols(ahub)[, "taxonomyid"] == taxid) 7 | target2 <- which(mcols(ahub)[, "rdataclass"] %in% c("OrgDb")) 8 | target <- intersect(target1, target2) 9 | ah_ids <- rev(rownames(mcols(ahub))[target]) 10 | hit <- FALSE 11 | for(i in seq_along(ah_ids)){ 12 | ah_id <- ah_ids[i] 13 | ah <- ahub[[ah_id]] 14 | check <- length(which(AnnotationDbi::columns(ah) == "ENTREZID")) == 1 15 | if(check){ 16 | hit <- TRUE 17 | break 18 | } 19 | } 20 | if(hit){ 21 | ah 22 | }else{ 23 | ################################### 24 | # EnsDb Search 25 | ################################### 26 | target3 <- which(mcols(ahub)[, "rdataclass"] %in% c("EnsDb")) 27 | target <- intersect(target1, target3) 28 | ah_ids <- rev(rownames(mcols(ahub))[target]) 29 | hit <- FALSE 30 | for(i in seq_along(ah_ids)){ 31 | ah_id <- ah_ids[i] 32 | ah <- ahub[[ah_id]] 33 | check <- length(which(AnnotationDbi::columns(ah) == "ENTREZID")) == 1 34 | if(check){ 35 | hit <- TRUE 36 | break 37 | } 38 | } 39 | if(hit){ 40 | ah 41 | }else{ 42 | NULL 43 | } 44 | } 45 | } 46 | 47 | .annotationhub <- list( 48 | "Hsa" = function(){ 49 | query(AnnotationHub(), c("OrgDb", "Homo sapiens", "org.Hs.eg.db.sqlite"))[[1]] 50 | }, 51 | "Mmu" = function(){ 52 | query(AnnotationHub(), c("OrgDb", "Mus musculus", "org.Mm.eg.db.sqlite"))[[1]] 53 | }, 54 | "Ath" = function(){ 55 | query(AnnotationHub(), c("OrgDb", "Arabidopsis thaliana", "org.At.tair.db.sqlite"))[[1]] 56 | }, 57 | "Rno" = function(){ 58 | query(AnnotationHub(), c("OrgDb", "Rattus norvegicus", "org.Rn.eg.db.sqlite"))[[1]] 59 | }, 60 | "Bta" = function(){ 61 | query(AnnotationHub(), c("OrgDb", "Bos taurus", "org.Bt.eg.db.sqlite"))[[1]] 62 | }, 63 | "Cel" = function(){ 64 | query(AnnotationHub(), c("OrgDb", "Caenorhabditis elegans", "org.Ce.eg.db.sqlite"))[[1]] 65 | }, 66 | "Dme" = function(){ 67 | query(AnnotationHub(), c("OrgDb", "Drosophila melanogaster", "org.Dm.eg.db.sqlite"))[[1]] 68 | }, 69 | "Dre" = function(){ 70 | query(AnnotationHub(), c("OrgDb", "Danio rerio", "org.Dr.eg.db.sqlite"))[[1]] 71 | }, 72 | "Gga" = function(){ 73 | query(AnnotationHub(), c("OrgDb", "Gallus gallus", "org.Gg.eg.db.sqlite"))[[1]] 74 | }, 75 | "Pab" = function(){ 76 | query(AnnotationHub(), c("OrgDb", "Pongo abelii", "org.Pongo_abelii.eg.sqlite"))[[1]] 77 | }, 78 | "Xtr" = function(){ 79 | query(AnnotationHub(), c("OrgDb", "Xenopus", "Silurana", "org.Xenopus_\\(Silurana\\)_tropicalis.eg.sqlite"))[[1]] 80 | }, 81 | "Ssc" = function(){ 82 | query(AnnotationHub(), c("OrgDb", "Sus scrofa", "org.Ss.eg.db.sqlite"))[[1]] 83 | } 84 | ) 85 | -------------------------------------------------------------------------------- /R/CCSParams-methods.R: -------------------------------------------------------------------------------- 1 | newCCSParams <- function() { 2 | new("CCSParams") 3 | } 4 | 5 | setMethod("getParam", "CCSParams", function(object, name){ 6 | slot(object, name) 7 | }) 8 | setMethod("setParam<-", "CCSParams", function(object, name, value){ 9 | slot(object, name) <- value 10 | validObject(object) 11 | return(object) 12 | }) 13 | setMethod("show", "CCSParams", function(object){ 14 | cat("A", crayon::bold("CCSParams"), "object of class", 15 | crayon::bold(class(object)), "\n") 16 | }) 17 | -------------------------------------------------------------------------------- /R/cellCellReport-Enrichment.R: -------------------------------------------------------------------------------- 1 | .GOENRICHMENT <- function(all, sig, ah, category, p){ 2 | goParams <- try(new("GOHyperGParams", 3 | geneIds=sig, 4 | universeGeneIds=all, 5 | annotation=ah, 6 | ontology=category, 7 | pvalueCutoff=p, 8 | conditional=FALSE, 9 | testDirection="over"), silent=TRUE) 10 | if(class(goParams) != "try-error"){ 11 | # Hyper geometric p-value 12 | out <- try(summary(hyperGTest(goParams)), silent=TRUE) 13 | if(is(out)[1] == "try-error"){ 14 | list(Term=NULL, Pvalue=NULL) 15 | }else{ 16 | list(Term=out$Term, Pvalue=out$Pvalue) 17 | } 18 | }else{ 19 | list(Term=NULL, Pvalue=NULL) 20 | } 21 | } 22 | 23 | .MeSHENRICHMENT <- function(all, sig, e, category, p){ 24 | if(class(e$meshannotation) != "MeSHDb"){ 25 | list(Term=NULL, Pvalue=NULL) 26 | }else{ 27 | meshParams <- new("MeSHHyperGParams", 28 | geneIds = sig, 29 | universeGeneIds = all, 30 | annotation = "e$meshannotation", 31 | meshdb = "e$meshdb", 32 | category = category, 33 | database = "gene2pubmed", 34 | pvalueCutoff = p, 35 | pAdjust = "none") 36 | # Hyper geometric p-value 37 | out <- try(summary(meshHyperGTest(meshParams)), silent=TRUE) 38 | if(is(out)[1] == "try-error"){ 39 | list(Term=NULL, Pvalue=NULL) 40 | }else{ 41 | outTerm <- unique(out$MESHTERM) 42 | outPvalue <- sapply(outTerm, function(x){ 43 | out$Pvalue[which(out$MESHTERM == x)[1]] 44 | }) 45 | list(Term=outTerm, Pvalue=outPvalue) 46 | } 47 | } 48 | } 49 | 50 | .ReactomeENRICHMENT <- function(all, sig, reactomespc, p){ 51 | if(is.na(reactomespc)){ 52 | list(Term=NULL, Pvalue=NULL) 53 | }else{ 54 | out <- try(enrichPathway(gene=sig, 55 | organism=reactomespc, 56 | pvalueCutoff=p, readable=TRUE), silent=TRUE) 57 | if(is(out)[1] == "try-error"){ 58 | list(Term=NULL, Pvalue=NULL) 59 | }else if(is.null(out)){ 60 | list(Term=NULL, Pvalue=NULL) 61 | }else{ 62 | list(Term=out@result$Description, 63 | Pvalue=out@result$pvalue) 64 | } 65 | } 66 | } 67 | 68 | .DOENRICHMENT <- function(all, sig, p){ 69 | out <- try(enrichDO(gene=sig, 70 | pvalueCutoff=p, readable=TRUE), silent=TRUE) 71 | if(is(out)[1] == "try-error"){ 72 | list(Term=NULL, Pvalue=NULL) 73 | }else if(is.null(out)){ 74 | list(Term=NULL, Pvalue=NULL) 75 | }else{ 76 | list(Term=out@result$Description, 77 | Pvalue=out@result$pvalue) 78 | } 79 | } 80 | 81 | .NCGENRICHMENT <- function(all, sig, p){ 82 | out <- try(enrichNCG(gene=sig, 83 | pvalueCutoff=p, readable=TRUE), silent=TRUE) 84 | if(is(out)[1] == "try-error"){ 85 | list(Term=NULL, Pvalue=NULL) 86 | }else if(is.null(out)){ 87 | list(Term=NULL, Pvalue=NULL) 88 | }else{ 89 | list(Term=out@result$Description, 90 | Pvalue=out@result$pvalue) 91 | } 92 | } 93 | 94 | .DGNENRICHMENT <- function(all, sig, p){ 95 | out <- try(enrichDGN(gene=sig, 96 | pvalueCutoff=p, readable=TRUE), silent=TRUE) 97 | if(is(out)[1] == "try-error"){ 98 | list(Term=NULL, Pvalue=NULL) 99 | }else if(is.null(out)){ 100 | list(Term=NULL, Pvalue=NULL) 101 | }else{ 102 | list(Term=out@result$Description, 103 | Pvalue=out@result$pvalue) 104 | } 105 | } 106 | 107 | .NOSIG <- list(Term=NULL, PValue=NULL) 108 | 109 | .ENRICHMENT <- function(all, sig, e, 110 | reactomespc, goenrich, meshenrich, reactomeenrich, 111 | doenrich, ncgenrich, dgnenrich, p, ah){ 112 | # GO 113 | if(goenrich){ 114 | cat("GO-Enrichment Analysis is running...(1/3)\n") 115 | BP <- .GOENRICHMENT(all, sig, ah, "BP", p) 116 | cat("GO-Enrichment Analysis is running...(2/3)\n") 117 | MF <- .GOENRICHMENT(all, sig, ah, "MF", p) 118 | cat("GO-Enrichment Analysis is running...(3/3)\n") 119 | CC <- .GOENRICHMENT(all, sig, ah, "CC", p) 120 | }else{ 121 | BP <- .NOSIG 122 | MF <- .NOSIG 123 | CC <- .NOSIG 124 | } 125 | # MeSH 126 | if(meshenrich){ 127 | cat("MeSH-Enrichment Analysis is running...(1/16)\n") 128 | A <- .MeSHENRICHMENT(all, sig, e, "A", p) 129 | cat("MeSH-Enrichment Analysis is running...(2/16)\n") 130 | B <- .MeSHENRICHMENT(all, sig, e, "B", p) 131 | cat("MeSH-Enrichment Analysis is running...(3/16)\n") 132 | C <- .MeSHENRICHMENT(all, sig, e, "C", p) 133 | cat("MeSH-Enrichment Analysis is running...(4/16)\n") 134 | D <- .MeSHENRICHMENT(all, sig, e, "D", p) 135 | cat("MeSH-Enrichment Analysis is running...(5/16)\n") 136 | E <- .MeSHENRICHMENT(all, sig, e, "E", p) 137 | cat("MeSH-Enrichment Analysis is running...(6/16)\n") 138 | F <- .MeSHENRICHMENT(all, sig, e, "F", p) 139 | cat("MeSH-Enrichment Analysis is running...(7/16)\n") 140 | G <- .MeSHENRICHMENT(all, sig, e, "G", p) 141 | cat("MeSH-Enrichment Analysis is running...(8/16)\n") 142 | H <- .MeSHENRICHMENT(all, sig, e, "H", p) 143 | cat("MeSH-Enrichment Analysis is running...(9/16)\n") 144 | I <- .MeSHENRICHMENT(all, sig, e, "I", p) 145 | cat("MeSH-Enrichment Analysis is running...(10/16)\n") 146 | J <- .MeSHENRICHMENT(all, sig, e, "J", p) 147 | cat("MeSH-Enrichment Analysis is running...(11/16)\n") 148 | K <- .MeSHENRICHMENT(all, sig, e, "K", p) 149 | cat("MeSH-Enrichment Analysis is running...(12/16)\n") 150 | L <- .MeSHENRICHMENT(all, sig, e, "L", p) 151 | cat("MeSH-Enrichment Analysis is running...(13/16)\n") 152 | M <- .MeSHENRICHMENT(all, sig, e, "M", p) 153 | cat("MeSH-Enrichment Analysis is running...(14/16)\n") 154 | N <- .MeSHENRICHMENT(all, sig, e, "N", p) 155 | cat("MeSH-Enrichment Analysis is running...(15/16)\n") 156 | V <- .MeSHENRICHMENT(all, sig, e, "V", p) 157 | cat("MeSH-Enrichment Analysis is running...(16/16)\n") 158 | Z <- .MeSHENRICHMENT(all, sig, e, "Z", p) 159 | }else{ 160 | A <- .NOSIG 161 | B <- .NOSIG 162 | C <- .NOSIG 163 | D <- .NOSIG 164 | E <- .NOSIG 165 | F <- .NOSIG 166 | G <- .NOSIG 167 | H <- .NOSIG 168 | I <- .NOSIG 169 | J <- .NOSIG 170 | K <- .NOSIG 171 | L <- .NOSIG 172 | M <- .NOSIG 173 | N <- .NOSIG 174 | V <- .NOSIG 175 | Z <- .NOSIG 176 | } 177 | # Reactome 178 | if(reactomeenrich){ 179 | cat("Reactome-Enrichment Analysis is running...(1/1)\n") 180 | Reactome <- .ReactomeENRICHMENT(all, sig, reactomespc, p) 181 | }else{ 182 | Reactome <- .NOSIG 183 | } 184 | # DO 185 | if(doenrich){ 186 | cat("DO-Enrichment Analysis is running...(1/1)\n") 187 | DO <- .DOENRICHMENT(all, sig, p) 188 | }else{ 189 | DO <- .NOSIG 190 | } 191 | # NCG 192 | if(ncgenrich){ 193 | cat("NCG-Enrichment Analysis is running...(1/1)\n") 194 | NCG <- .NCGENRICHMENT(all, sig, p) 195 | }else{ 196 | NCG <- .NOSIG 197 | } 198 | # DGN 199 | if(dgnenrich){ 200 | cat("DGN-Enrichment Analysis is running...(1/1)\n") 201 | DGN <- .DGNENRICHMENT(all, sig, p) 202 | }else{ 203 | DGN <- .NOSIG 204 | } 205 | 206 | # Output 207 | out <- list(BP, MF, CC, 208 | A, B, C, D, E, F, G, H, I, J, K, L, M, N, V, Z, 209 | Reactome, DO, NCG, DGN) 210 | # Exception 211 | out <- lapply(out, function(x){ 212 | if(length(x$Term) == 0 || length(x$Pvalue) == 0){ 213 | .NOSIG 214 | }else{ 215 | x 216 | } 217 | }) 218 | names(out) <- c( 219 | "GO_BP", "GO_MF", "GO_CC", 220 | "MeSH_A", "MeSH_B", "MeSH_C", "MeSH_D", 221 | "MeSH_E", "MeSH_F", "MeSH_G", "MeSH_H", 222 | "MeSH_I", "MeSH_J", "MeSH_K", "MeSH_L", 223 | "MeSH_M", "MeSH_N", "MeSH_V", "MeSH_Z", 224 | "Reactome", "DO", "NCG", "DGN" 225 | ) 226 | out 227 | } 228 | -------------------------------------------------------------------------------- /R/cellCellReport-NTD.R: -------------------------------------------------------------------------------- 1 | .cellCellReport.Third <- function(sce, thr, upper, assayNames, reducedDimNames, out.dir, author, title, p, top, 2 | goenrich, meshenrich, reactomeenrich, doenrich, 3 | ncgenrich, dgnenrich, nbins){ 4 | # Core Tensor 5 | index <- metadata(sce)$sctensor$index 6 | corevalue <- index[, "Value"] 7 | corevalue <- corevalue / sum(corevalue) * 100 8 | # Thresholding of the elements of core tensor 9 | selected <- which(cumsum(corevalue) <= thr) 10 | if(length(selected) > upper){ 11 | selected <- seq_len(upper) 12 | } 13 | if(length(selected) == 0){ 14 | stop(paste0("None of core tensor element is selected.\n", 15 | "Please specify the larger thr or perform cellCellDecomp\n", 16 | "with smaller ranks such as c(3,3,3).")) 17 | }else{ 18 | names(corevalue) <- c(rep("selected", length=length(selected)), 19 | rep("not selected", 20 | length=length(corevalue) - length(selected))) 21 | # Import expression matrix 22 | input <- .importAssays(sce, assayNames) 23 | # Low dimensional data 24 | twoD <- eval(parse(text=paste0("reducedDims(sce)$", reducedDimNames))) 25 | # Ligand-Receptor, PMID 26 | lr.evidence <- metadata(sce)$lr.evidence 27 | LR <- .extractLR(sce, lr.evidence, 28 | c("GENEID_L", "GENEID_R", "SOURCEID")) 29 | # SQLite connection 30 | con = dbConnect(SQLite(), metadata(sce)$lrbase) 31 | taxid <- dbGetQuery(con, "SELECT * FROM METADATA") 32 | taxid <- taxid[which(taxid$NAME == "TAXID"), "VALUE"] 33 | dbDisconnect(con) 34 | ########################################### 35 | # Taxonomy ID based information retrieval 36 | ########################################### 37 | # biomaRt Setting 38 | ah <- .annotationhub_taxid(taxid) 39 | # GeneName, Description, GO, Reactome, MeSH 40 | GeneInfo <- .geneInformation_taxid(sce, ah, taxid, LR) 41 | # Cell Label 42 | celltypes <- metadata(sce)$color 43 | names(celltypes) <- metadata(sce)$label 44 | 45 | # Setting of schex 46 | sce <- make_hexbin(sce, nbins=nbins, 47 | dimension_reduction=reducedDimNames) 48 | # Plot Ligand/Receptor Genes 49 | suppressMessages( 50 | invisible(.genePlot(sce, assayNames, input, out.dir, GeneInfo, LR))) 51 | # Plot (Each ) 52 | out <- vapply(seq_along(selected), function(i){ 53 | filenames <- paste0(out.dir, 54 | "/figures/CCIHypergraph_", index[i, 1], 55 | "_", index[i, 2], ".png") 56 | png(filename=filenames, width=2000, height=950) 57 | invisible(.CCIhyperGraphPlot(metadata(sce)$sctensor, 58 | twoDplot=twoD, 59 | label=celltypes, 60 | emph=index[i, seq_len(2)])) 61 | dev.off() 62 | }, 0L) 63 | # <*,*,LR> 64 | SelectedLR <- sort(unique(index[selected, "Mode3"])) 65 | 66 | # Setting for Parallel Computing 67 | message(paste0(length(SelectedLR), 68 | " LR vectors will be calculated :")) 69 | e <<- new.env() 70 | e$p <- p 71 | e$index <- index 72 | e$sce <- sce 73 | e$ah <- ah 74 | e$.HCLUST <- .HCLUST 75 | e$.OUTLIERS <- .OUTLIERS 76 | e$top <- top 77 | e$GeneInfo <- GeneInfo 78 | e$out.dir <- out.dir 79 | e$.smallTwoDplot <- .smallTwoDplot 80 | e$input <- input 81 | e$twoD <- twoD 82 | e$.hyperLinks <- .hyperLinks 83 | e$LR <- LR 84 | e$taxid <- taxid 85 | e$.eachVecLR <- .eachVecLR 86 | e$.eachRender <- .eachRender 87 | e$.XYZ_HEADER1 <- .XYZ_HEADER1 88 | e$.XYZ_HEADER2 <- .XYZ_HEADER2 89 | e$.XYZ_HEADER3 <- .XYZ_HEADER3 90 | e$.XYZ_ENRICH <- .XYZ_ENRICH 91 | e$algorithm <- metadata(sce)$algorithm 92 | e$goenrich <- goenrich 93 | e$meshenrich <- meshenrich 94 | e$reactomeenrich <- reactomeenrich 95 | e$doenrich <- doenrich 96 | e$ncgenrich <- ncgenrich 97 | e$dgnenrich <- dgnenrich 98 | 99 | # EachVec（Heavy...） 100 | out.vecLR <- vapply(SelectedLR, 101 | function(x, e){.eachVecLR(x, e)}, 102 | FUN.VALUE=rep(list(0L), 9), e=e) 103 | colnames(out.vecLR) <- paste0("pattern", SelectedLR) 104 | e$out.vecLR <- out.vecLR 105 | 106 | # Tagcloud 107 | invisible(.tagCloud(out.vecLR, out.dir)) 108 | # Plot（CCI Hypergraph） 109 | png(filename=paste0(out.dir, "/figures/CCIHypergraph.png"), 110 | width=2000, height=950) 111 | invisible(.CCIhyperGraphPlot(metadata(sce)$sctensor, 112 | twoDplot=twoD, label=celltypes)) 113 | dev.off() 114 | # Plot（Gene-wise Hypergraph） 115 | invisible(g <- .geneHyperGraphPlot(out.vecLR, GeneInfo, out.dir)) 116 | 117 | # Rmd（ligand, selected） 118 | message("ligand.Rmd is created...") 119 | outLg <- file(paste0(out.dir, "/ligand.Rmd"), "w") 120 | writeLines(.LIGAND_HEADER, outLg, sep="\n") 121 | writeLines(.LIGAND_BODY(out.vecLR, GeneInfo, index, selected), outLg, sep="\n") 122 | close(outLg) 123 | # Rmd（receptor, selected） 124 | message("receptor.Rmd is created...") 125 | outRp <- file(paste0(out.dir, "/receptor.Rmd"), "w") 126 | writeLines(.RECEPTOR_HEADER, outRp, sep="\n") 127 | writeLines(.RECEPTOR_BODY(out.vecLR, GeneInfo, index, selected), outRp, sep="\n") 128 | close(outRp) 129 | # Rmd（ligand, all） 130 | message("ligand_all.Rmd is created...") 131 | outLg_all <- file(paste0(out.dir, "/ligand_all.Rmd"), "w") 132 | writeLines(.LIGANDALL_HEADER, outLg_all, sep="\n") 133 | writeLines(.LIGANDALL_BODY(GeneInfo, LR, input), 134 | outLg_all, sep="\n") 135 | close(outLg_all) 136 | # Rmd（receptor, all） 137 | message("receptor_all.Rmd is created...") 138 | outRp_all <- file(paste0(out.dir, "/receptor_all.Rmd"), "w") 139 | writeLines(.RECEPTORALL_HEADER, outRp_all, sep="\n") 140 | writeLines(.RECEPTORALL_BODY(GeneInfo, LR, input), 141 | outRp_all, sep="\n") 142 | close(outRp_all) 143 | 144 | # Number of Patterns 145 | vecL <- metadata(sce)$sctensor$ligand 146 | vecR <- metadata(sce)$sctensor$receptor 147 | numLPattern <- nrow(vecL) 148 | numRPattern <- nrow(vecR) 149 | col.ligand <- .setColor("reds") 150 | col.receptor <- .setColor("blues") 151 | # Clustering 152 | ClusterL <- t(apply(vecL, 1, .HCLUST)) 153 | ClusterR <- t(apply(vecR, 1, .HCLUST)) 154 | # Ligand Pattern 155 | invisible(.ligandPatternPlot(numLPattern, celltypes, sce, col.ligand, ClusterL, out.dir, twoD)) 156 | # Receptor Pattern 157 | invisible(.receptorPatternPlot(numRPattern, celltypes, sce, 158 | col.receptor, ClusterR, out.dir, twoD)) 159 | # Save the result of scTensor 160 | save(sce, input, twoD, LR, celltypes, index, corevalue, 161 | selected, ClusterL, ClusterR, out.vecLR, g, 162 | file=paste0(out.dir, "/reanalysis.RData")) 163 | 164 | # Rendering 165 | message("ligand.Rmd is compiled to ligand.html...") 166 | render(paste0(out.dir, "/ligand.Rmd"), quiet=TRUE) 167 | message("ligand_all.Rmd is compiled to ligand_all.html...") 168 | render(paste0(out.dir, "/ligand_all.Rmd"), quiet=TRUE) 169 | message("receptor.Rmd is compiled to receptor.html...") 170 | render(paste0(out.dir, "/receptor.Rmd"), quiet=TRUE) 171 | message("receptor_all.Rmd is compiled to receptor_all.html...") 172 | render(paste0(out.dir, "/receptor_all.Rmd"), quiet=TRUE) 173 | message(paste0(length(selected), 174 | " pattern_X_Y_Z.Rmd files are compiled to pattern_X_Y_Z.html :")) 175 | out <- vapply(selected, 176 | function(x, e, SelectedLR){ 177 | .eachRender(x, e, SelectedLR)}, "", e=e, SelectedLR=SelectedLR) 178 | 179 | # Output index.html 180 | RMDFILES <- vapply(selected, function(x){ 181 | paste0(paste(c("pattern", index[x, seq_len(3)]), 182 | collapse="_"), ".Rmd") 183 | }, "") 184 | message("index.Rmd is created...") 185 | outIdx <- file(paste0(out.dir, "/index.Rmd"), "w") 186 | writeLines(.MAINHEADER(author, title), outIdx, sep="\n") 187 | writeLines(.BODY1, outIdx, sep="\n") 188 | writeLines(.BODY2, outIdx, sep="\n") 189 | writeLines(.BODY3(numLPattern, ClusterL), outIdx, sep="\n") 190 | writeLines(.BODY4(numRPattern, ClusterR), outIdx, sep="\n") 191 | writeLines(.BODY5, outIdx, sep="\n") 192 | writeLines(.BODY6, outIdx, sep="\n") 193 | writeLines(.BODY7, outIdx, sep="\n") 194 | if(length(selected) != 0){ 195 | writeLines(.BODY8(selected, RMDFILES, index, corevalue), 196 | outIdx, sep="\n") 197 | } 198 | writeLines(.BODY9, outIdx, sep="\n") 199 | writeLines(.BODY10, outIdx, sep="\n") 200 | close(outIdx) 201 | 202 | # Rendering 203 | message("index.Rmd is compiled to index.html...") 204 | render(paste0(out.dir, "/index.Rmd"), quiet=TRUE) 205 | } 206 | } 207 | 208 | .CCIhyperGraphPlot <- function(outobj, twoDplot=NULL, vertex.size=18, 209 | xleft=1.75, ybottom=-0.5, xright=1.85, ytop=0.5, label="", emph=NULL, algorithm=""){ 210 | # Number of Patterns 211 | numLPattern <- nrow(outobj$ligand) 212 | numRPattern <- nrow(outobj$receptor) 213 | 214 | # 215 | # Step.1 : Background Network 216 | # 217 | edgewd_L <- as.vector(vapply(seq_len(numLPattern), function(x){ 218 | rep(x, numRPattern) 219 | }, rep(0L, numRPattern))) 220 | edgewd_R <- rep(seq_len(numRPattern), numLPattern) 221 | edgewd_Strength <- vapply( 222 | seq_len(numLPattern*numRPattern), function(x){ 223 | targetL <- which( 224 | outobj$index[, "Mode1"] == edgewd_L[x]) 225 | targetR <- which( 226 | outobj$index[, "Mode2"] == edgewd_R[x]) 227 | sum(outobj$index[intersect(targetL, targetR), 4]) 228 | }, 0.0) 229 | edgewd <- cbind(edgewd_L, edgewd_R, edgewd_Strength) 230 | colnames(edgewd) <- c("L", "R", "Strength") 231 | 232 | # Node name (Top and Bottom) 233 | nodesSetTop <- paste0("L", seq_len(numLPattern)) 234 | nodesSetBottom <- paste0("R", seq_len(numRPattern)) 235 | 236 | # Empty Graph 237 | g <- graph.empty() 238 | 239 | # Add nodes 240 | g <- add.vertices(g, nv=length(nodesSetTop), 241 | attr=list(name=nodesSetTop, 242 | type=rep(TRUE, length(nodesSetTop)))) 243 | g <- add.vertices(g, nv=length(nodesSetBottom), 244 | attr=list(name=nodesSetBottom, 245 | type=rep(TRUE, length(nodesSetBottom)))) 246 | 247 | # Add edges 248 | edgeListVec <- as.vector(t(as.matrix( 249 | data.frame( 250 | S1=paste0('L', edgewd[,1]), 251 | S2=paste0('R', edgewd[,2]) 252 | )))) 253 | g <- add.edges(g, edgeListVec) 254 | 255 | # Edge weghts 256 | E(g)$weight <- edgewd[,3] 257 | 258 | # Edge color 259 | weight <- E(g)$weight 260 | E(g)$weight <- weight / max(weight) * 20 261 | mycolor <- smoothPalette(E(g)$weight, 262 | palfunc=colorRampPalette(.setColor("greens"), alpha=TRUE)) 263 | if(!is.null(emph)){ 264 | target <- intersect( 265 | which(get.edgelist(g)[, 1] == paste0("L", emph[1])), 266 | which(get.edgelist(g)[, 2] == paste0("R", emph[2]))) 267 | mycolor[target] <- rgb(1,0,0,0.5) 268 | } 269 | 270 | # Layout 271 | x <- c(seq_along(nodesSetTop), seq_along(nodesSetBottom)) 272 | y <- c(rep(1, length=length(nodesSetTop)), 273 | rep(0, length=length(nodesSetBottom))) 274 | mylayout <- cbind(x, y) 275 | 276 | # Network Plot 277 | par(oma=c(2,2,2,2)) 278 | plot.igraph(g, 279 | layout=mylayout, 280 | vertex.size=18, 281 | vertex.label="", 282 | vertex.color="white", 283 | vertex.shape="square", 284 | edge.color=mycolor, 285 | vertex.frame.color="gray", 286 | edge.width=E(g)$weight) 287 | 288 | # Gradient 289 | gradient.rect(xleft, ybottom, xright, ytop, 290 | col=smoothPalette(sort(weight), 291 | palfunc=colorRampPalette(.setColor("greens"), alpha=TRUE)), 292 | gradient="y") 293 | text(2.2, ybottom+(ytop-ybottom)*0/4, round(quantile(weight)[1])) 294 | text(2.2, ybottom+(ytop-ybottom)*1/4, round(quantile(weight)[2])) 295 | text(2.2, ybottom+(ytop-ybottom)*2/4, round(quantile(weight)[3])) 296 | text(2.2, ybottom+(ytop-ybottom)*3/4, round(quantile(weight)[4])) 297 | text(2.2, ybottom+(ytop-ybottom)*4/4, round(quantile(weight)[5])) 298 | text(1.8, ybottom+(ytop-ybottom)*4.5/4, "CCI-Strength", cex=2) 299 | text(-1.5, -1, "Receptor Patterns", cex=2) 300 | text(-1.5, 1, "Ligand Patterns", cex=2) 301 | 302 | if(!is.null(twoDplot)){ 303 | # Setting 304 | maLR <- max(numLPattern, numRPattern) 305 | if(1 <= maLR && maLR <= 16){ 306 | omasize <- .omasize(numLPattern, numRPattern) 307 | oma4 <- .oma4(numLPattern, numRPattern) 308 | # 309 | # Step.2 : Ligand Plot 310 | # 311 | # Color 312 | col.ligand <- .setColor("reds") 313 | # Constant 314 | LOMA_1 = 48.85 315 | LOMA_2 = 42 316 | LOMA_3 = 4 317 | out <- vapply(seq_len(numLPattern), function(i){ 318 | label.ligand <- unlist(vapply(names(label), 319 | function(x){ 320 | outobj$ligand[paste0("Dim", i), x] 321 | }, 0.0)) 322 | label.ligand[] <- smoothPalette(label.ligand, 323 | palfunc=colorRampPalette(col.ligand, alpha=TRUE)) 324 | par(new=TRUE) 325 | par(oma = c(LOMA_1, LOMA_2+(i-1)*omasize, 326 | LOMA_3, oma4-omasize*i)) 327 | plot(twoDplot, col=label.ligand, pch=16, cex=0.5, bty="n", 328 | xaxt="n", yaxt="n", xlab="", ylab="", 329 | main=paste0("(", i, ",*,*)")) 330 | 0L 331 | }, 0L) 332 | 333 | # 334 | # Step.3 : Receptor Plot 335 | # 336 | # Color 337 | col.receptor <- .setColor("blues") 338 | # Constant 339 | ROMA_1 = 4 340 | ROMA_2 = 42 341 | ROMA_3 = 48.85 342 | out <- vapply(seq_len(numRPattern), function(i){ 343 | label.receptor <- unlist(vapply(names(label), 344 | function(x){ 345 | outobj$receptor[paste0("Dim", i), x] 346 | }, 0.0)) 347 | label.receptor[] <- smoothPalette(label.receptor, 348 | palfunc=colorRampPalette(col.receptor, alpha=TRUE)) 349 | par(new=TRUE) 350 | par(oma = c(ROMA_1, ROMA_2+(i-1)*omasize, 351 | ROMA_3, oma4-omasize*i)) 352 | plot(twoDplot, col=label.receptor, pch=16, cex=0.5, 353 | bty="n", xaxt="n", yaxt="n", xlab="", ylab="", 354 | main=paste0("(*,", i, ",*)")) 355 | 0L 356 | }, 0L) 357 | }else{ 358 | warning(paste0("LR plot can be performed when \n", 359 | "the maximum number of Ligand/Receptor patterns are \n", 360 | "higher than 1 and smaller than 12 for now.")) 361 | } 362 | } 363 | } 364 | 365 | .geneHyperGraphPlot <- function(out.vecLR, GeneInfo, out.dir){ 366 | # Setting 367 | convertGeneName <- function(geneid, GeneInfo){ 368 | if(!is.null(GeneInfo$GeneName)){ 369 | genename <- GeneInfo$GeneName[ 370 | which(GeneInfo$GeneName$ENTREZID == geneid), 371 | "SYMBOL"][1] 372 | if(length(genename) == 0 || genename %in% c("", NA)){ 373 | genename = geneid 374 | } 375 | genename 376 | }else{ 377 | geneid 378 | } 379 | } 380 | 381 | # Node 382 | nodes <- lapply(seq_len(ncol(out.vecLR)), function(x){ 383 | names(out.vecLR["TARGET", x][[1]])}) 384 | Lnodes <- lapply(nodes, function(x){ 385 | vapply(x, function(xx){ 386 | strsplit(xx, "_")[[1]][1] 387 | }, "") 388 | }) 389 | Rnodes <-lapply(nodes, function(x){ 390 | vapply(x, function(xx){ 391 | strsplit(xx, "_")[[1]][2] 392 | }, "") 393 | }) 394 | Lnodes <- lapply(Lnodes, function(x){ 395 | vapply(x, function(xx){ 396 | convertGeneName(xx, GeneInfo) 397 | }, "") 398 | }) 399 | Rnodes <- lapply(Rnodes, function(x){ 400 | vapply(x, function(xx){ 401 | convertGeneName(xx, GeneInfo) 402 | }, "") 403 | }) 404 | uniqueLnodes <- unique(unlist(Lnodes)) 405 | uniqueRnodes <- unique(unlist(Rnodes)) 406 | 407 | # Empty Graph 408 | g <- graph.empty(directed=FALSE) 409 | # Add nodes 410 | g <- add.vertices(g, nv=length(uniqueLnodes), 411 | attr=list(name=uniqueLnodes, 412 | type=rep(TRUE, length(uniqueLnodes)), 413 | color=rgb(1,0,0,0.5))) 414 | g <- add.vertices(g, nv=length(uniqueRnodes), 415 | attr=list(name=uniqueRnodes, 416 | type=rep(TRUE, length(uniqueRnodes)), 417 | color=rgb(0,0,1,0.5))) 418 | 419 | # Nodes Weight 420 | freqLnodes <- vapply(uniqueLnodes, function(x){ 421 | length(which(unlist(Lnodes) == x)) 422 | }, 0L) 423 | freqRnodes <- vapply(uniqueRnodes, function(x){ 424 | length(which(unlist(Rnodes) == x)) 425 | }, 0L) 426 | freq <- c(freqLnodes, freqRnodes) 427 | freq <- freq / max(freq) * 10 428 | 429 | # Add edges 430 | edgeListVec <- as.vector(t(as.matrix( 431 | data.frame( 432 | L=unlist(Lnodes), 433 | R=unlist(Rnodes) 434 | )))) 435 | g <- add.edges(g, edgeListVec) 436 | 437 | # Plot 438 | cols <- .setColor("many") 439 | edge.cols <- unlist(lapply(seq_len(ncol(out.vecLR)), function(x){ 440 | rep(cols[x], length(out.vecLR["TARGET", x][[1]])) 441 | })) 442 | 443 | # Setting 444 | V(g)$size <- freq 445 | E(g)$color <- edge.cols 446 | E(g)$width <- 0.7 447 | l <- layout_with_dh(g) 448 | 449 | # All Pattern 450 | png(filename=paste0(out.dir, "/figures/GeneHypergraph.png"), 451 | width=2500, height=2500) 452 | plot.igraph(g, layout=l) 453 | legend("topleft", 454 | legend=c("ligand", "receptor", 455 | colnames(out.vecLR)), 456 | col=c(rgb(1,0,0,0.5), rgb(0,0,1,0.5), 457 | cols[seq_len(ncol(out.vecLR))]), 458 | pch=16, cex=2.2) 459 | dev.off() 460 | 461 | # Each Pattern 462 | out <- vapply(seq_len(ncol(out.vecLR)), function(x){ 463 | tmp_edgecolor <- edge.cols 464 | tmp_edgecolor[which(tmp_edgecolor != cols[x])] <- rgb(0,0,0,0.1) 465 | tmp_nodecolor <- V(g)$color 466 | grayout <- setdiff( 467 | setdiff( 468 | names(V(g)), 469 | Lnodes[[x]] 470 | ), Rnodes[[x]] 471 | ) 472 | target <- unlist(lapply(grayout, function(xx){ 473 | which(names(V(g)) == xx) 474 | })) 475 | tmp_nodecolor[target] <- rgb(0,0,0,0.1) 476 | 477 | # Plot 478 | png(filename=paste0( 479 | out.dir, "/figures/GeneHypergraph_", 480 | gsub("pattern", "", colnames(out.vecLR)[x]), 481 | ".png"), 482 | width=2500, height=2500) 483 | plot.igraph(g, 484 | vertex.color=tmp_nodecolor, 485 | edge.color=tmp_edgecolor, layout=l) 486 | legend("topleft", 487 | legend=c("ligand", "receptor", 488 | colnames(out.vecLR)[x]), 489 | col=c(rgb(1,0,0,0.5), rgb(0,0,1,0.5), 490 | cols[x]), 491 | pch=16, cex=2.2) 492 | dev.off() 493 | }, 0L) 494 | return(g) 495 | } 496 | 497 | .tagCloud <- function(out.vecLR, out.dir){ 498 | sapply(seq_len(ncol(out.vecLR)), function(x){ 499 | # Pvalue 500 | Pvalues <- list( 501 | GO_BP=out.vecLR["Enrich", x][[1]]$GO_BP$Pvalue, 502 | GO_MF=out.vecLR["Enrich", x][[1]]$GO_MF$Pvalue, 503 | GO_CC=out.vecLR["Enrich", x][[1]]$GO_CC$Pvalue, 504 | MeSH_A=out.vecLR["Enrich", x][[1]]$MeSH_A$Pvalue, 505 | MeSH_B=out.vecLR["Enrich", x][[1]]$MeSH_B$Pvalue, 506 | MeSH_C=out.vecLR["Enrich", x][[1]]$MeSH_C$Pvalue, 507 | MeSH_D=out.vecLR["Enrich", x][[1]]$MeSH_D$Pvalue, 508 | MeSH_E=out.vecLR["Enrich", x][[1]]$MeSH_E$Pvalue, 509 | MeSH_F=out.vecLR["Enrich", x][[1]]$MeSH_F$Pvalue, 510 | MeSH_G=out.vecLR["Enrich", x][[1]]$MeSH_G$Pvalue, 511 | MeSH_H=out.vecLR["Enrich", x][[1]]$MeSH_H$Pvalue, 512 | MeSH_I=out.vecLR["Enrich", x][[1]]$MeSH_I$Pvalue, 513 | MeSH_J=out.vecLR["Enrich", x][[1]]$MeSH_J$Pvalue, 514 | MeSH_K=out.vecLR["Enrich", x][[1]]$MeSH_K$Pvalue, 515 | MeSH_L=out.vecLR["Enrich", x][[1]]$MeSH_L$Pvalue, 516 | MeSH_M=out.vecLR["Enrich", x][[1]]$MeSH_M$Pvalue, 517 | MeSH_N=out.vecLR["Enrich", x][[1]]$MeSH_N$Pvalue, 518 | MeSH_V=out.vecLR["Enrich", x][[1]]$MeSH_V$Pvalue, 519 | MeSH_Z=out.vecLR["Enrich", x][[1]]$MeSH_Z$Pvalue, 520 | Reactome=out.vecLR["Enrich", x][[1]]$Reactome$Pvalue, 521 | DO=out.vecLR["Enrich", x][[1]]$DO$Pvalue, 522 | NCG=out.vecLR["Enrich", x][[1]]$NCG$Pvalue, 523 | DGN=out.vecLR["Enrich", x][[1]]$DGN$Pvalue 524 | ) 525 | # Term 526 | Terms <- list( 527 | GO_BP=out.vecLR["Enrich", x][[1]]$GO_BP$Term, 528 | GO_MF=out.vecLR["Enrich", x][[1]]$GO_MF$Term, 529 | GO_CC=out.vecLR["Enrich", x][[1]]$GO_CC$Term, 530 | MeSH_A=out.vecLR["Enrich", x][[1]]$MeSH_A$Term, 531 | MeSH_B=out.vecLR["Enrich", x][[1]]$MeSH_B$Term, 532 | MeSH_C=out.vecLR["Enrich", x][[1]]$MeSH_C$Term, 533 | MeSH_D=out.vecLR["Enrich", x][[1]]$MeSH_D$Term, 534 | MeSH_E=out.vecLR["Enrich", x][[1]]$MeSH_E$Term, 535 | MeSH_F=out.vecLR["Enrich", x][[1]]$MeSH_F$Term, 536 | MeSH_G=out.vecLR["Enrich", x][[1]]$MeSH_G$Term, 537 | MeSH_H=out.vecLR["Enrich", x][[1]]$MeSH_H$Term, 538 | MeSH_I=out.vecLR["Enrich", x][[1]]$MeSH_I$Term, 539 | MeSH_J=out.vecLR["Enrich", x][[1]]$MeSH_J$Term, 540 | MeSH_K=out.vecLR["Enrich", x][[1]]$MeSH_K$Term, 541 | MeSH_L=out.vecLR["Enrich", x][[1]]$MeSH_L$Term, 542 | MeSH_M=out.vecLR["Enrich", x][[1]]$MeSH_M$Term, 543 | MeSH_N=out.vecLR["Enrich", x][[1]]$MeSH_N$Term, 544 | MeSH_V=out.vecLR["Enrich", x][[1]]$MeSH_V$Term, 545 | MeSH_Z=out.vecLR["Enrich", x][[1]]$MeSH_Z$Term, 546 | Reactome=out.vecLR["Enrich", x][[1]]$Reactome$Term, 547 | DO=out.vecLR["Enrich", x][[1]]$DO$Term, 548 | NCG=out.vecLR["Enrich", x][[1]]$NCG$Term, 549 | DGN=out.vecLR["Enrich", x][[1]]$DGN$Term 550 | ) 551 | lapply(names(Pvalues), function(xx){ 552 | # Pvalue 553 | pval <- eval(parse(text=paste0("Pvalues$", xx))) 554 | # Term 555 | t <- as.character(eval(parse(text=paste0("Terms$", xx)))) 556 | # Plot 557 | if(!is.null(pval)){ 558 | png(filename=paste0(out.dir, "/figures/Tagcloud/", xx, 559 | "_", colnames(out.vecLR)[x], 560 | ".png"), width=1000, height=1000) 561 | if(length(pval) == 1){ 562 | t <- sapply(t, function(x){.shrink2(x, thr=7)}) 563 | .SinglePlot(t) 564 | }else{ 565 | negLogPval <- -log10(pval+1E-10) 566 | target <- seq_len(min(100, length(pval))) 567 | if(length(pval) <= 5){ 568 | t <- sapply(t, function(x){.shrink2(x, thr=10)}) 569 | }else{ 570 | t <- sapply(t, function(x){.shrink2(x, thr=25)}) 571 | } 572 | tagcloud(t[target], weights = negLogPval[target], 573 | col = smoothPalette(negLogPval[target], palfunc = .palf), 574 | order = "size", algorithm = "fill", 575 | scale.multiplier=0.8) 576 | } 577 | dev.off() 578 | } 579 | }) 580 | }) 581 | } 582 | 583 | .eachRender <- function(x, e, SelectedLR){ 584 | index <- e$index 585 | out.dir <- e$out.dir 586 | out.vecLR <- e$out.vecLR 587 | .XYZ_HEADER1 <- e$.XYZ_HEADER1 588 | .XYZ_HEADER2 <- e$.XYZ_HEADER2 589 | .XYZ_HEADER3 <- e$.XYZ_HEADER3 590 | .XYZ_ENRICH <- e$.XYZ_ENRICH 591 | 592 | indexLR <- index[x, "Mode3"] 593 | TARGET <- out.vecLR[, paste0("pattern", indexLR)]$TARGET 594 | LINKS <- out.vecLR[, paste0("pattern", indexLR)]$LINKS 595 | 596 | # Bottom part of Rmarkdown 597 | XYZ_BOTTOM <- paste( 598 | c(.XYZ_HEADER2(indexLR, x, length(TARGET)), 599 | LINKS, 600 | .XYZ_HEADER3(indexLR), 601 | .XYZ_ENRICH(out.vecLR, indexLR)), 602 | collapse="") 603 | 604 | # Each (x,y,z)-rmdfile 605 | RMDFILE <- paste0(c("pattern", index[x, seq_len(3)]), collapse="_") 606 | RMDFILE <- paste0(RMDFILE, ".Rmd") 607 | cat(paste0("\n", RMDFILE, " is created...\n")) 608 | sink(file = paste0(out.dir, "/", RMDFILE)) 609 | cat(paste( 610 | c(.XYZ_HEADER1(index, x), XYZ_BOTTOM), 611 | collapse="")) 612 | sink() 613 | 614 | # Rendering 615 | message(paste0(RMDFILE, " is compiled to ", 616 | gsub(".Rmd", ".html", RMDFILE))) 617 | render(paste0(out.dir, "/", RMDFILE), quiet=TRUE) 618 | } 619 | -------------------------------------------------------------------------------- /R/cellCellReport-NTD2.R: -------------------------------------------------------------------------------- 1 | .cellCellReport.Third_2 <- function(sce, thr, upper, assayNames, reducedDimNames, out.dir, author, title, p, top, 2 | goenrich, meshenrich, reactomeenrich, 3 | doenrich, ncgenrich, dgnenrich, nbins){ 4 | # Core Tensor 5 | index <- metadata(sce)$sctensor$index 6 | corevalue <- index[, "Value"] 7 | corevalue <- corevalue / sum(corevalue) * 100 8 | # Thresholding of the elements of core tensor 9 | selected <- which(cumsum(corevalue) <= thr) 10 | if(length(selected) > upper){ 11 | selected <- seq_len(upper) 12 | } 13 | if(length(selected) == 0){ 14 | stop(paste0("None of core tensor element is selected.\n", 15 | "Please specify the larger thr or perform cellCellDecomp\n", 16 | "with larger ranks such as c(# celltypes,# celltypes,1).")) 17 | }else{ 18 | names(corevalue) <- c(rep("selected", length=length(selected)), 19 | rep("not selected", 20 | length=length(corevalue) - length(selected))) 21 | # Import expression matrix 22 | input <- .importAssays(sce, assayNames) 23 | # Low dimensional data 24 | twoD <- eval(parse(text=paste0("reducedDims(sce)$", reducedDimNames))) 25 | # Ligand-Receptor, PMID 26 | lr.evidence <- metadata(sce)$lr.evidence 27 | LR <- .extractLR(sce, lr.evidence, 28 | c("GENEID_L", "GENEID_R", "SOURCEID", "SOURCEDB")) 29 | # SQLite connection 30 | con = dbConnect(SQLite(), metadata(sce)$lrbase) 31 | taxid <- dbGetQuery(con, "SELECT * FROM METADATA") 32 | taxid <- taxid[which(taxid$NAME == "TAXID"), "VALUE"] 33 | dbDisconnect(con) 34 | ########################################### 35 | # Taxonomy ID based information retrieval 36 | ########################################### 37 | # biomaRt Setting 38 | ah <- .annotationhub_taxid(taxid) 39 | # GeneName, Description, GO, Reactome, MeSH 40 | GeneInfo <- .geneInformation_taxid(sce, ah, taxid, LR) 41 | # Cell Label 42 | celltypes <- metadata(sce)$color 43 | names(celltypes) <- metadata(sce)$label 44 | # Setting of schex 45 | sce <- make_hexbin(sce, nbins=nbins, 46 | dimension_reduction=reducedDimNames) 47 | # Plot Ligand/Receptor Genes 48 | suppressMessages( 49 | invisible(.genePlot(sce, assayNames, input, out.dir, GeneInfo, LR))) 50 | # Plot (Each ) 51 | out <- vapply(seq_along(selected), function(i){ 52 | filenames <- paste0(out.dir, 53 | "/figures/CCIHypergraph_", index[i, 1], 54 | "_", index[i, 2], ".png") 55 | png(filename=filenames, width=2000, height=950) 56 | invisible(.CCIhyperGraphPlot_2(metadata(sce)$sctensor, 57 | twoDplot=twoD, 58 | label=celltypes, 59 | emph=index[i, seq_len(2)])) 60 | dev.off() 61 | }, 0L) 62 | # 63 | SelectedLR <- index[selected, seq_len(2)] 64 | # Setting for Parallel Computing 65 | message(paste0(length(selected), 66 | " LR vectors will be calculated :")) 67 | e <<- new.env() 68 | e$p <- p 69 | e$index <- index 70 | e$sce <- sce 71 | e$ah <- ah 72 | e$.HCLUST <- .HCLUST 73 | e$.OUTLIERS <- .OUTLIERS 74 | e$top <- top 75 | e$GeneInfo <- GeneInfo 76 | e$out.dir <- out.dir 77 | e$.smallTwoDplot <- .smallTwoDplot 78 | e$input <- input 79 | e$twoD <- twoD 80 | e$.hyperLinks <- .hyperLinks 81 | e$LR <- LR 82 | e$taxid <- taxid 83 | e$.eachVecLR <- .eachVecLR 84 | e$.eachRender_2 <- .eachRender_2 85 | e$.XYZ_HEADER1_2 <- .XYZ_HEADER1_2 86 | e$.XYZ_HEADER2_2 <- .XYZ_HEADER2_2 87 | e$.XYZ_HEADER3_2 <- .XYZ_HEADER3_2 88 | e$.XYZ_ENRICH_2 <- .XYZ_ENRICH_2 89 | e$algorithm <- metadata(sce)$algorithm 90 | e$goenrich <- goenrich 91 | e$meshenrich <- meshenrich 92 | e$reactomeenrich <- reactomeenrich 93 | e$doenrich <- doenrich 94 | e$ncgenrich <- ncgenrich 95 | e$dgnenrich <- dgnenrich 96 | 97 | # EachVec（Heavy...） 98 | if(is.vector(SelectedLR)){ 99 | SelectedLR <- t(SelectedLR) 100 | } 101 | out.vecLR <- apply(SelectedLR, 1, 102 | function(x, e){.eachVecLR(x, e)}, e=e) 103 | names(out.vecLR) <- apply(SelectedLR, 1, function(x){ 104 | paste(c("pattern", x[1], x[2]), collapse="_") 105 | }) 106 | e$out.vecLR <- out.vecLR 107 | 108 | # Tagcloud 109 | invisible(.tagCloud_2(out.vecLR, out.dir)) 110 | # Plot（CCI Hypergraph） 111 | png(filename=paste0(out.dir, "/figures/CCIHypergraph.png"), 112 | width=2000, height=950) 113 | invisible(.CCIhyperGraphPlot_2(metadata(sce)$sctensor, 114 | twoDplot=twoD, label=celltypes)) 115 | dev.off() 116 | # Plot（Gene-wise Hypergraph） 117 | invisible(g <- .geneHyperGraphPlot_2(out.vecLR, GeneInfo, out.dir)) 118 | 119 | # Rmd（ligand, selected） 120 | message("ligand.Rmd is created...") 121 | outLg <- file(paste0(out.dir, "/ligand.Rmd"), "w") 122 | writeLines(.LIGAND_HEADER, outLg, sep="\n") 123 | writeLines(.LIGAND_BODY_2(out.vecLR, GeneInfo, index, selected), outLg, sep="\n") 124 | close(outLg) 125 | # Rmd（receptor, selected） 126 | message("receptor.Rmd is created...") 127 | outRp <- file(paste0(out.dir, "/receptor.Rmd"), "w") 128 | writeLines(.RECEPTOR_HEADER, outRp, sep="\n") 129 | writeLines(.RECEPTOR_BODY_2(out.vecLR, GeneInfo, index, selected), outRp, sep="\n") 130 | close(outRp) 131 | # Rmd（ligand, all） 132 | message("ligand_all.Rmd is created...") 133 | outLg_all <- file(paste0(out.dir, "/ligand_all.Rmd"), "w") 134 | writeLines(.LIGANDALL_HEADER, outLg_all, sep="\n") 135 | writeLines(.LIGANDALL_BODY(GeneInfo, LR, input), 136 | outLg_all, sep="\n") 137 | close(outLg_all) 138 | # Rmd（receptor, all） 139 | message("receptor_all.Rmd is created...") 140 | outRp_all <- file(paste0(out.dir, "/receptor_all.Rmd"), "w") 141 | writeLines(.RECEPTORALL_HEADER, outRp_all, sep="\n") 142 | writeLines(.RECEPTORALL_BODY(GeneInfo, LR, input), 143 | outRp_all, sep="\n") 144 | close(outRp_all) 145 | 146 | # Number of Patterns 147 | vecL <- metadata(sce)$sctensor$ligand 148 | vecR <- metadata(sce)$sctensor$receptor 149 | numLPattern <- nrow(vecL) 150 | numRPattern <- nrow(vecR) 151 | col.ligand <- .setColor("reds") 152 | col.receptor <- .setColor("blues") 153 | # Clustering 154 | ClusterL <- t(apply(vecL, 1, .HCLUST)) 155 | ClusterR <- t(apply(vecR, 1, .HCLUST)) 156 | # Ligand Pattern 157 | invisible(.ligandPatternPlot(numLPattern, celltypes, sce, col.ligand, ClusterL, out.dir, twoD)) 158 | # Receptor Pattern 159 | invisible(.receptorPatternPlot(numRPattern, celltypes, sce, 160 | col.receptor, ClusterR, out.dir, twoD)) 161 | # Save the result of scTensor 162 | save(sce, input, twoD, LR, celltypes, index, corevalue, 163 | selected, ClusterL, ClusterR, out.vecLR, g, 164 | file=paste0(out.dir, "/reanalysis.RData")) 165 | 166 | # Rendering 167 | message("ligand.Rmd is compiled to ligand.html...") 168 | render(paste0(out.dir, "/ligand.Rmd"), quiet=TRUE) 169 | message("ligand_all.Rmd is compiled to ligand_all.html...") 170 | render(paste0(out.dir, "/ligand_all.Rmd"), quiet=TRUE) 171 | message("receptor.Rmd is compiled to receptor.html...") 172 | render(paste0(out.dir, "/receptor.Rmd"), quiet=TRUE) 173 | message("receptor_all.Rmd is compiled to receptor_all.html...") 174 | render(paste0(out.dir, "/receptor_all.Rmd"), quiet=TRUE) 175 | message(paste0(length(selected), 176 | " pattern_X_Y.Rmd files are compiled to pattern_X_Y.html :")) 177 | out <- vapply(selected, 178 | function(x, e, SelectedLR){ 179 | .eachRender_2(x, e, SelectedLR)}, "", e=e, SelectedLR=SelectedLR) 180 | 181 | # Output index.html 182 | RMDFILES <- vapply(selected, function(x){ 183 | paste0(paste(c("pattern", index[x, seq_len(2)]), 184 | collapse="_"), ".Rmd") 185 | }, "") 186 | message("\nindex.Rmd is created...") 187 | outIdx <- file(paste0(out.dir, "/index.Rmd"), "w") 188 | writeLines(.MAINHEADER(author, title), outIdx, sep="\n") 189 | writeLines(.BODY1_2, outIdx, sep="\n") 190 | writeLines(.BODY2_2, outIdx, sep="\n") 191 | writeLines(.BODY3(numLPattern, ClusterL), outIdx, sep="\n") 192 | writeLines(.BODY4(numRPattern, ClusterR), outIdx, sep="\n") 193 | writeLines(.BODY6, outIdx, sep="\n") 194 | writeLines(.BODY7, outIdx, sep="\n") 195 | if(length(selected) != 0){ 196 | writeLines(.BODY8_2(selected, RMDFILES, index, corevalue), 197 | outIdx, sep="\n") 198 | } 199 | writeLines(.BODY9, outIdx, sep="\n") 200 | writeLines(.BODY10, outIdx, sep="\n") 201 | close(outIdx) 202 | 203 | # Rendering 204 | message("index.Rmd is compiled to index.html...\n") 205 | render(paste0(out.dir, "/index.Rmd"), quiet=TRUE) 206 | } 207 | } 208 | 209 | .CCIhyperGraphPlot_2 <- function(outobj, twoDplot=NULL, vertex.size=18, 210 | xleft=1.75, ybottom=-0.5, xright=1.85, ytop=0.5, label="", emph=NULL, algorithm=""){ 211 | # Number of Patterns 212 | numLPattern <- nrow(outobj$ligand) 213 | numRPattern <- nrow(outobj$receptor) 214 | 215 | # 216 | # Step.1 : Background Network 217 | # 218 | edgewd_L <- as.vector(vapply(seq_len(numLPattern), function(x){ 219 | rep(x, numRPattern) 220 | }, rep(0L, numRPattern))) 221 | edgewd_R <- rep(seq_len(numRPattern), numLPattern) 222 | edgewd_Strength <- vapply( 223 | seq_len(numLPattern*numRPattern), function(x){ 224 | targetL <- which( 225 | outobj$index[, "Mode1"] == edgewd_L[x]) 226 | targetR <- which( 227 | outobj$index[, "Mode2"] == edgewd_R[x]) 228 | sum(outobj$index[intersect(targetL, targetR), 3]) 229 | }, 0.0) 230 | edgewd <- cbind(edgewd_L, edgewd_R, edgewd_Strength) 231 | colnames(edgewd) <- c("L", "R", "Strength") 232 | 233 | # Node name (Top and Bottom) 234 | nodesSetTop <- paste0("L", seq_len(numLPattern)) 235 | nodesSetBottom <- paste0("R", seq_len(numRPattern)) 236 | 237 | # Empty Graph 238 | g <- graph.empty() 239 | 240 | # Add nodes 241 | g <- add.vertices(g, nv=length(nodesSetTop), 242 | attr=list(name=nodesSetTop, 243 | type=rep(TRUE, length(nodesSetTop)))) 244 | g <- add.vertices(g, nv=length(nodesSetBottom), 245 | attr=list(name=nodesSetBottom, 246 | type=rep(TRUE, length(nodesSetBottom)))) 247 | 248 | # Add edges 249 | edgeListVec <- as.vector(t(as.matrix( 250 | data.frame( 251 | S1=paste0('L', edgewd[,1]), 252 | S2=paste0('R', edgewd[,2]) 253 | )))) 254 | g <- add.edges(g, edgeListVec) 255 | 256 | # Edge weghts 257 | E(g)$weight <- edgewd[,3] 258 | 259 | # Edge color 260 | weight <- E(g)$weight 261 | E(g)$weight <- weight / max(weight) * 20 262 | mycolor <- smoothPalette(E(g)$weight, 263 | palfunc=colorRampPalette(.setColor("greens"), alpha=TRUE)) 264 | if(!is.null(emph)){ 265 | target <- intersect( 266 | which(get.edgelist(g)[, 1] == paste0("L", emph[1])), 267 | which(get.edgelist(g)[, 2] == paste0("R", emph[2]))) 268 | mycolor[target] <- rgb(1,0,0,0.5) 269 | } 270 | 271 | # Layout 272 | x <- c(seq_along(nodesSetTop), seq_along(nodesSetBottom)) 273 | y <- c(rep(1, length=length(nodesSetTop)), 274 | rep(0, length=length(nodesSetBottom))) 275 | mylayout <- cbind(x, y) 276 | 277 | # Network Plot 278 | par(oma=c(2,2,2,2)) 279 | plot.igraph(g, 280 | layout=mylayout, 281 | vertex.size=18, 282 | vertex.label="", 283 | vertex.color="white", 284 | vertex.shape="square", 285 | edge.color=mycolor, 286 | vertex.frame.color="gray", 287 | edge.width=E(g)$weight) 288 | 289 | # Gradient 290 | gradient.rect(xleft, ybottom, xright, ytop, 291 | col=smoothPalette(sort(weight), 292 | palfunc=colorRampPalette(.setColor("greens"), alpha=TRUE)), 293 | gradient="y") 294 | text(2.2, ybottom+(ytop-ybottom)*0/4, round(quantile(weight)[1])) 295 | text(2.2, ybottom+(ytop-ybottom)*1/4, round(quantile(weight)[2])) 296 | text(2.2, ybottom+(ytop-ybottom)*2/4, round(quantile(weight)[3])) 297 | text(2.2, ybottom+(ytop-ybottom)*3/4, round(quantile(weight)[4])) 298 | text(2.2, ybottom+(ytop-ybottom)*4/4, round(quantile(weight)[5])) 299 | text(1.8, ybottom+(ytop-ybottom)*4.5/4, "CCI-Strength", cex=2) 300 | text(-1.5, -1, "Receptor Patterns", cex=2) 301 | text(-1.5, 1, "Ligand Patterns", cex=2) 302 | 303 | if(!is.null(twoDplot)){ 304 | # Setting 305 | maLR <- max(numLPattern, numRPattern) 306 | if(1 <= maLR && maLR <= 16){ 307 | omasize <- .omasize(numLPattern, numRPattern) 308 | oma4 <- .oma4(numLPattern, numRPattern) 309 | # 310 | # Step.2 : Ligand Plot 311 | # 312 | # Color 313 | col.ligand <- .setColor("reds") 314 | # Constant 315 | LOMA_1 = 48.85 316 | LOMA_2 = 42 317 | LOMA_3 = 4 318 | out <- vapply(seq_len(numLPattern), function(i){ 319 | label.ligand <- unlist(vapply(names(label), 320 | function(x){ 321 | outobj$ligand[paste0("Dim", i), x] 322 | }, 0.0)) 323 | label.ligand[] <- smoothPalette(label.ligand, 324 | palfunc=colorRampPalette(col.ligand, alpha=TRUE)) 325 | par(new=TRUE) 326 | par(oma = c(LOMA_1, LOMA_2+(i-1)*omasize, 327 | LOMA_3, oma4-omasize*i)) 328 | plot(twoDplot, col=label.ligand, pch=16, cex=0.5, bty="n", 329 | xaxt="n", yaxt="n", xlab="", ylab="", 330 | main=paste0("(", i, ",*,*)")) 331 | 0L 332 | }, 0L) 333 | 334 | # 335 | # Step.3 : Receptor Plot 336 | # 337 | # Color 338 | col.receptor <- .setColor("blues") 339 | # Constant 340 | ROMA_1 = 4 341 | ROMA_2 = 42 342 | ROMA_3 = 48.85 343 | out <- vapply(seq_len(numRPattern), function(i){ 344 | label.receptor <- unlist(vapply(names(label), 345 | function(x){ 346 | outobj$receptor[paste0("Dim", i), x] 347 | }, 0.0)) 348 | label.receptor[] <- smoothPalette(label.receptor, 349 | palfunc=colorRampPalette(col.receptor, alpha=TRUE)) 350 | par(new=TRUE) 351 | par(oma = c(ROMA_1, ROMA_2+(i-1)*omasize, 352 | ROMA_3, oma4-omasize*i)) 353 | plot(twoDplot, col=label.receptor, pch=16, cex=0.5, 354 | bty="n", xaxt="n", yaxt="n", xlab="", ylab="", 355 | main=paste0("(*,", i, ",*)")) 356 | 0L 357 | }, 0L) 358 | }else{ 359 | warning(paste0("LR plot can be performed when \n", 360 | "the maximum number of Ligand/Receptor patterns are \n", 361 | "higher than 1 and smaller than 12 for now.")) 362 | } 363 | } 364 | } 365 | 366 | .geneHyperGraphPlot_2 <- function(out.vecLR, GeneInfo, out.dir){ 367 | # Setting 368 | convertGeneName <- function(geneid, GeneInfo){ 369 | if(!is.null(GeneInfo$GeneName)){ 370 | genename <- GeneInfo$GeneName[ 371 | which(GeneInfo$GeneName$ENTREZID == geneid), 372 | "SYMBOL"][1] 373 | if(is.na(genename[1])){ 374 | genename = geneid 375 | } 376 | genename 377 | }else{ 378 | geneid 379 | } 380 | } 381 | 382 | # Node 383 | nodes <- lapply(seq_len(length(out.vecLR)), function(x){ 384 | names(out.vecLR[[x]]$TARGET)}) 385 | Lnodes <- lapply(nodes, function(x){ 386 | vapply(x, function(xx){ 387 | strsplit(xx, "_")[[1]][1] 388 | }, "") 389 | }) 390 | Rnodes <-lapply(nodes, function(x){ 391 | vapply(x, function(xx){ 392 | strsplit(xx, "_")[[1]][2] 393 | }, "") 394 | }) 395 | Lnodes <- lapply(Lnodes, function(x){ 396 | vapply(x, function(xx){ 397 | convertGeneName(xx, GeneInfo) 398 | }, "") 399 | }) 400 | Rnodes <- lapply(Rnodes, function(x){ 401 | vapply(x, function(xx){ 402 | convertGeneName(xx, GeneInfo) 403 | }, "") 404 | }) 405 | uniqueLnodes <- unique(unlist(Lnodes)) 406 | uniqueRnodes <- unique(unlist(Rnodes)) 407 | 408 | # Empty Graph 409 | g <- graph.empty(directed=FALSE) 410 | # Add nodes 411 | g <- add.vertices(g, nv=length(uniqueLnodes), 412 | attr=list(name=uniqueLnodes, 413 | type=rep(TRUE, length(uniqueLnodes)), 414 | color=rgb(1,0,0,0.5))) 415 | g <- add.vertices(g, nv=length(uniqueRnodes), 416 | attr=list(name=uniqueRnodes, 417 | type=rep(TRUE, length(uniqueRnodes)), 418 | color=rgb(0,0,1,0.5))) 419 | 420 | # Nodes Weight 421 | freqLnodes <- vapply(uniqueLnodes, function(x){ 422 | length(which(unlist(Lnodes) == x)) 423 | }, 0L) 424 | freqRnodes <- vapply(uniqueRnodes, function(x){ 425 | length(which(unlist(Rnodes) == x)) 426 | }, 0L) 427 | freq <- c(freqLnodes, freqRnodes) 428 | freq <- freq / max(freq) * 10 429 | 430 | # Add edges 431 | edgeListVec <- as.vector(t(as.matrix( 432 | data.frame( 433 | L=unlist(Lnodes), 434 | R=unlist(Rnodes) 435 | )))) 436 | g <- add.edges(g, edgeListVec) 437 | 438 | # Plot 439 | cols <- .setColor("many") 440 | edge.cols <- unlist(lapply(seq_len(length(out.vecLR)), function(x){ 441 | rep(cols[x], length(out.vecLR[[x]]$TARGET)) 442 | })) 443 | 444 | # Setting 445 | V(g)$size <- freq 446 | E(g)$color <- edge.cols 447 | E(g)$width <- 0.7 448 | l <- layout_with_dh(g) 449 | 450 | # All Pattern 451 | png(filename=paste0(out.dir, "/figures/GeneHypergraph.png"), 452 | width=2500, height=2500) 453 | plot.igraph(g, layout=l) 454 | legend("topleft", 455 | legend=c("ligand", "receptor", 456 | names(out.vecLR)), 457 | col=c(rgb(1,0,0,0.5), rgb(0,0,1,0.5), 458 | cols[seq_len(length(out.vecLR))]), 459 | pch=16, cex=2.2) 460 | dev.off() 461 | 462 | # Each Pattern 463 | out <- vapply(seq_len(length(out.vecLR)), function(x){ 464 | tmp_edgecolor <- edge.cols 465 | tmp_edgecolor[which(tmp_edgecolor != cols[x])] <- rgb(0,0,0,0.1) 466 | tmp_nodecolor <- V(g)$color 467 | grayout <- setdiff( 468 | setdiff( 469 | names(V(g)), 470 | Lnodes[[x]] 471 | ), Rnodes[[x]] 472 | ) 473 | target <- unlist(lapply(grayout, function(xx){ 474 | which(names(V(g)) == xx) 475 | })) 476 | tmp_nodecolor[target] <- rgb(0,0,0,0.1) 477 | 478 | # Plot 479 | png(filename=paste0( 480 | out.dir, "/figures/GeneHypergraph", 481 | gsub("pattern", "", names(out.vecLR)[x]), 482 | ".png"), 483 | width=2500, height=2500) 484 | plot.igraph(g, 485 | vertex.color=tmp_nodecolor, 486 | edge.color=tmp_edgecolor, layout=l) 487 | legend("topleft", 488 | legend=c("ligand", "receptor", 489 | names(out.vecLR)[x]), 490 | col=c(rgb(1,0,0,0.5), rgb(0,0,1,0.5), 491 | cols[x]), 492 | pch=16, cex=2.2) 493 | dev.off() 494 | }, 0L) 495 | return(g) 496 | } 497 | 498 | .tagCloud_2 <- function(out.vecLR, out.dir){ 499 | sapply(seq_len(length(out.vecLR)), function(x){ 500 | # Pvalue 501 | Pvalues <- list( 502 | GO_BP=out.vecLR[[x]]$Enrich$GO_BP$Pvalue, 503 | GO_MF=out.vecLR[[x]]$Enrich$GO_MF$Pvalue, 504 | GO_CC=out.vecLR[[x]]$Enrich$GO_CC$Pvalue, 505 | MeSH_A=out.vecLR[[x]]$Enrich$MeSH_A$Pvalue, 506 | MeSH_B=out.vecLR[[x]]$Enrich$MeSH_B$Pvalue, 507 | MeSH_C=out.vecLR[[x]]$Enrich$MeSH_C$Pvalue, 508 | MeSH_D=out.vecLR[[x]]$Enrich$MeSH_D$Pvalue, 509 | MeSH_E=out.vecLR[[x]]$Enrich$MeSH_E$Pvalue, 510 | MeSH_F=out.vecLR[[x]]$Enrich$MeSH_F$Pvalue, 511 | MeSH_G=out.vecLR[[x]]$Enrich$MeSH_G$Pvalue, 512 | MeSH_H=out.vecLR[[x]]$Enrich$MeSH_H$Pvalue, 513 | MeSH_I=out.vecLR[[x]]$Enrich$MeSH_I$Pvalue, 514 | MeSH_J=out.vecLR[[x]]$Enrich$MeSH_J$Pvalue, 515 | MeSH_K=out.vecLR[[x]]$Enrich$MeSH_K$Pvalue, 516 | MeSH_L=out.vecLR[[x]]$Enrich$MeSH_L$Pvalue, 517 | MeSH_M=out.vecLR[[x]]$Enrich$MeSH_M$Pvalue, 518 | MeSH_N=out.vecLR[[x]]$Enrich$MeSH_N$Pvalue, 519 | MeSH_V=out.vecLR[[x]]$Enrich$MeSH_V$Pvalue, 520 | MeSH_Z=out.vecLR[[x]]$Enrich$MeSH_Z$Pvalue, 521 | Reactome=out.vecLR[[x]]$Enrich$Reactome$Pvalue, 522 | DO=out.vecLR[[x]]$Enrich$DO$Pvalue, 523 | NCG=out.vecLR[[x]]$Enrich$NCG$Pvalue, 524 | DGN=out.vecLR[[x]]$Enrich$DGN$Pvalue 525 | ) 526 | # Term 527 | Terms <- list( 528 | GO_BP=out.vecLR[[x]]$Enrich$GO_BP$Term, 529 | GO_MF=out.vecLR[[x]]$Enrich$GO_MF$Term, 530 | GO_CC=out.vecLR[[x]]$Enrich$GO_CC$Term, 531 | MeSH_A=out.vecLR[[x]]$Enrich$MeSH_A$Term, 532 | MeSH_B=out.vecLR[[x]]$Enrich$MeSH_B$Term, 533 | MeSH_C=out.vecLR[[x]]$Enrich$MeSH_C$Term, 534 | MeSH_D=out.vecLR[[x]]$Enrich$MeSH_D$Term, 535 | MeSH_E=out.vecLR[[x]]$Enrich$MeSH_E$Term, 536 | MeSH_F=out.vecLR[[x]]$Enrich$MeSH_F$Term, 537 | MeSH_G=out.vecLR[[x]]$Enrich$MeSH_G$Term, 538 | MeSH_H=out.vecLR[[x]]$Enrich$MeSH_H$Term, 539 | MeSH_I=out.vecLR[[x]]$Enrich$MeSH_I$Term, 540 | MeSH_J=out.vecLR[[x]]$Enrich$MeSH_J$Term, 541 | MeSH_K=out.vecLR[[x]]$Enrich$MeSH_K$Term, 542 | MeSH_L=out.vecLR[[x]]$Enrich$MeSH_L$Term, 543 | MeSH_M=out.vecLR[[x]]$Enrich$MeSH_M$Term, 544 | MeSH_N=out.vecLR[[x]]$Enrich$MeSH_N$Term, 545 | MeSH_V=out.vecLR[[x]]$Enrich$MeSH_V$Term, 546 | MeSH_Z=out.vecLR[[x]]$Enrich$MeSH_Z$Term, 547 | Reactome=out.vecLR[[x]]$Enrich$Reactome$Term, 548 | DO=out.vecLR[[x]]$Enrich$DO$Term, 549 | NCG=out.vecLR[[x]]$Enrich$NCG$Term, 550 | DGN=out.vecLR[[x]]$Enrich$DGN$Term 551 | ) 552 | lapply(names(Pvalues), function(xx){ 553 | # Pvalue 554 | pval <- eval(parse(text=paste0("Pvalues$", xx))) 555 | # Term 556 | t <- as.character(eval(parse(text=paste0("Terms$", xx)))) 557 | # Plot 558 | if(!is.null(pval)){ 559 | png(filename=paste0(out.dir, "/figures/Tagcloud/", xx, 560 | "_", names(out.vecLR)[x], 561 | ".png"), width=1000, height=1000) 562 | if(length(pval) == 1){ 563 | t <- sapply(t, function(x){.shrink2(x, thr=7)}) 564 | .SinglePlot(t) 565 | }else{ 566 | negLogPval <- -log10(pval+1E-10) 567 | target <- seq_len(min(100, length(pval))) 568 | if(length(pval) <= 5){ 569 | t <- sapply(t, function(x){.shrink2(x, thr=10)}) 570 | }else{ 571 | t <- sapply(t, function(x){.shrink2(x, thr=25)}) 572 | } 573 | tagcloud(t[target], weights = negLogPval[target], 574 | col = smoothPalette(negLogPval[target], palfunc = .palf), 575 | order = "size", algorithm = "fill", 576 | scale.multiplier=0.8) 577 | } 578 | dev.off() 579 | } 580 | }) 581 | }) 582 | } 583 | 584 | .eachRender_2 <- function(x, e, SelectedLR){ 585 | index <- e$index 586 | out.dir <- e$out.dir 587 | out.vecLR <- e$out.vecLR 588 | .XYZ_HEADER1_2 <- e$.XYZ_HEADER1_2 589 | .XYZ_HEADER2_2 <- e$.XYZ_HEADER2_2 590 | .XYZ_HEADER3_2 <- e$.XYZ_HEADER3_2 591 | .XYZ_ENRICH_2 <- e$.XYZ_ENRICH_2 592 | 593 | indexLR <- paste0(c("pattern", SelectedLR[x, ]), collapse="_") 594 | TARGET <- out.vecLR[[indexLR]]$TARGET 595 | LINKS <- out.vecLR[[indexLR]]$LINKS 596 | 597 | # Bottom part of Rmarkdown 598 | XYZ_BOTTOM <- paste( 599 | c(.XYZ_HEADER2_2(index, x, length(TARGET)), 600 | LINKS, 601 | .XYZ_HEADER3_2(index, x), 602 | .XYZ_ENRICH_2(out.vecLR, indexLR)), 603 | collapse="") 604 | 605 | # Each (x,y,z)-rmdfile 606 | RMDFILE <- paste0(c("pattern", index[x, seq_len(2)]), collapse="_") 607 | RMDFILE <- paste0(RMDFILE, ".Rmd") 608 | cat(paste0("\n", RMDFILE, " is created...\n")) 609 | sink(file = paste0(out.dir, "/", RMDFILE)) 610 | cat(paste( 611 | c(.XYZ_HEADER1_2(index, x), XYZ_BOTTOM), 612 | collapse="")) 613 | sink() 614 | 615 | # Rendering 616 | message(paste0(RMDFILE, " is compiled to ", 617 | gsub(".Rmd", ".html", RMDFILE))) 618 | render(paste0(out.dir, "/", RMDFILE), quiet=TRUE) 619 | } 620 | -------------------------------------------------------------------------------- /R/cellCellSimulate-internal.R: -------------------------------------------------------------------------------- 1 | .GenerateFC <- function (x, thr){ 2 | if (thr == "E1") { 3 | a <- 0.3213536 4 | b <- 0.1211649 5 | } 6 | else if (thr == "E2") { 7 | a <- 0.7019536 8 | b <- 0.3638012 9 | } 10 | else if (thr == "E5") { 11 | a <- 1.9079161 12 | b <- 0.6665197 13 | } 14 | else if (thr == "E10") { 15 | a <- 4.4291731 16 | b <- 0.8141489 17 | } 18 | else if (thr == "E50") { 19 | a <- 21.430831 20 | b <- 1.161132 21 | } 22 | else if (thr == "E100") { 23 | a <- 30.733509 24 | b <- 1.131347 25 | } 26 | else if (is.numeric(thr)) { 27 | stop("Wrong thr!!!") 28 | } 29 | 10^(a * exp(-b * log10(x + 1))) 30 | } 31 | 32 | 33 | # Random Matrix 34 | .matRnbinom <- function(m, disp, rn.index, num.Cell){ 35 | t(vapply(rn.index, function(x) { 36 | rnbinom(n = num.Cell, mu = m[x], size = 1/disp[x]) 37 | }, 1.0*seq_len(num.Cell))) 38 | } 39 | 40 | # Setting DEG 41 | .matFC <- function(nDEG, num.Gene, num.Cell, CCI, m, row.index, rn.index){ 42 | # Set FC 43 | fc.matrix <- matrix(1, nrow=num.Gene, ncol=length(num.Cell)) 44 | for(x in seq_along(CCI)){ 45 | lp <- which(CCI[[x]]$LPattern == 1) 46 | r <- row.index[[x]] 47 | fc.matrix[r, lp] <- .GenerateFC(m[rn.index][r], CCI[[x]]$fc) 48 | } 49 | for(x in seq_along(CCI)){ 50 | lp <- which(CCI[[x]]$RPattern == 1) 51 | r <- row.index[[x]] + sum(nDEG) 52 | fc.matrix[r, lp] <- .GenerateFC(m[rn.index][r], CCI[[x]]$fc) 53 | } 54 | fc.matrix 55 | } 56 | 57 | # Assign DEG 58 | .setDEG <- function(original.matrix, fc.matrix, num.Cell, rn.index, row.index, m, disp){ 59 | for (i in seq_along(num.Cell)) { 60 | deg.index <- which(fc.matrix[, i] != 1) 61 | col.index <- sum(num.Cell[1:i - 1]) + 1:sum(num.Cell[i]) 62 | if(length(deg.index) != 0){ 63 | original.matrix[deg.index, col.index] <- t(sapply(deg.index, 64 | function(x){ 65 | rnbinom(n = num.Cell[i], 66 | mu = fc.matrix[x, i] * m[rn.index[x]], 67 | size = 1/disp[rn.index[x]]) 68 | })) 69 | } 70 | } 71 | original.matrix 72 | } 73 | 74 | # Dropout Matrix 75 | .matDrop <- function(original.matrix, lambda, nCell){ 76 | mean.vector <- apply(original.matrix, 1, mean) 77 | var.vector <- apply(original.matrix, 1, var) 78 | droprate <- exp(-lambda * mean.vector^2) 79 | droprate.matrix <- vapply(seq_len(sum(nCell)), function(y){ 80 | unlist(lapply(droprate, function(x){ 81 | rbinom(1, 1, prob = (1 - x)) 82 | })) 83 | }, seq_len(nrow(original.matrix))) 84 | } 85 | 86 | .simulateDropoutCounts <- function(nGene, nCell, cciInfo, lambda, seed){ 87 | # Set Parameters 88 | CCI <- lapply(grep("CCI", names(cciInfo)), function(x){ 89 | cciInfo[[x]] 90 | }) 91 | LPattern <- lapply(grep("CCI", names(cciInfo)), function(x){ 92 | cciInfo[[x]]$LPattern 93 | }) 94 | RPattern <- lapply(grep("CCI", names(cciInfo)), function(x){ 95 | cciInfo[[x]]$RPattern 96 | }) 97 | nDEG <- unlist(lapply(grep("CCI", names(cciInfo)), function(x){ 98 | cciInfo[[x]]$nGene 99 | })) 100 | fc <- unlist(lapply(grep("CCI", names(cciInfo)), function(x){ 101 | cciInfo[[x]]$fc 102 | })) 103 | set.seed(seed) 104 | data("m") 105 | data("v") 106 | disp <- (v - m)/m^2 107 | rn.index <- sample(which(disp > 0), nGene, replace = TRUE) 108 | row.index <- list() 109 | start <- 1 110 | for(i in seq_along(nDEG)){ 111 | if(i == 1){ 112 | row.index[[i]] <- 1:nDEG[i] 113 | }else{ 114 | row.index[[i]] <- start:(start+nDEG[i]-1) 115 | } 116 | start <- start + nDEG[i] 117 | } 118 | 119 | # Check 120 | if(sum(nDEG) > cciInfo$nPair){ 121 | stop("Please specify larger cciInfo$nPair!") 122 | } 123 | if(length(nCell) != length(cciInfo$CCI1$LPattern)){ 124 | stop(paste0("Please specify the length of nCell is", 125 | " same as cciInfo$CCI*$LPattern ", 126 | "and cciInfo$CCI*$RPattern!")) 127 | } 128 | 129 | # Original matrix 130 | original.matrix <- .matRnbinom(m, disp, rn.index, sum(nCell)) 131 | 132 | # Setting DEG 133 | fc.matrix <- .matFC(nDEG, nGene, nCell, CCI, m, row.index, rn.index) 134 | original.matrix <- .setDEG(original.matrix, fc.matrix, 135 | nCell, rn.index, row.index, m, disp) 136 | 137 | # Setting Dropout 138 | droprate.matrix <- .matDrop(original.matrix, lambda, nCell) 139 | testdata.matrix <- original.matrix * droprate.matrix 140 | 141 | # Naming 142 | rownames(testdata.matrix) <- paste0("Gene", seq_len(nrow(testdata.matrix))) 143 | colnames(testdata.matrix) <- paste0("Cell", seq_len(ncol(testdata.matrix))) 144 | celltypes <- colnames(testdata.matrix) 145 | names(celltypes) <- unlist(lapply(seq_along(nCell), function(x){ 146 | paste0("Celltype", rep(x, length=nCell[x])) 147 | })) 148 | 149 | # L-R list 150 | rn <- rownames(testdata.matrix) 151 | start1 <- sum(nDEG)+1 152 | end1 <- 2*sum(nDEG) 153 | start2 <- end1 + 1 154 | end2 <- end1 + cciInfo$nPair - end1/2 155 | start3 <- end2 + 1 156 | end3 <- end2 + cciInfo$nPair - end1/2 157 | LR <- rbind( 158 | cbind(rn[seq_len(sum(nDEG))], rn[start1:end1]), 159 | cbind(rn[start2:end2], rn[start3:end3])) 160 | LR <- as.data.frame(LR) 161 | colnames(LR) <- c("GENEID_L", "GENEID_R") 162 | 163 | # L-R <-> CCI relationship 164 | LR_CCI <- seq_len(cciInfo$nPair) 165 | names(LR_CCI) <- c( 166 | unlist(lapply(seq_along(nDEG), function(x){ 167 | rep(paste0("CCI", x), nDEG[x]) 168 | })), 169 | rep("nonDEG", cciInfo$nPair - sum(nDEG))) 170 | rownames(LR) <- LR_CCI 171 | 172 | # Set random seed as default mode 173 | set.seed(NULL) 174 | 175 | # Output 176 | return( 177 | list(simcount = testdata.matrix, 178 | LR=LR, 179 | celltypes=celltypes, 180 | LR_CCI=LR_CCI)) 181 | } 182 | -------------------------------------------------------------------------------- /R/geneInformation.R: -------------------------------------------------------------------------------- 1 | .geneInformation_taxid <- function(sce, ah, taxid, LR){ 2 | targetGeneID <- as.character(unique(c(LR$GENEID_L, LR$GENEID_R))) 3 | # Gene symbol 4 | if("SYMBOL" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 5 | message("Related gene names are retrieved from AnnotationHub...") 6 | GeneName <- AnnotationDbi::select(ah, columns=c("SYMBOL", "ENTREZID"), 7 | keytype="ENTREZID", keys=targetGeneID) 8 | GeneName <- unique(GeneName) 9 | nonna1 <- which(!is.na(GeneName[,1])) 10 | nonna2 <- which(!is.na(GeneName[,2])) 11 | GeneName <- GeneName[intersect(nonna1, nonna2), ] 12 | # Bipartite Matching 13 | g <- graph.data.frame(as.data.frame(GeneName), directed=FALSE) 14 | V(g)$type <- bipartite_mapping(g)$type 15 | g <- max_bipartite_match(g) 16 | target <- as.character(unique(GeneName[, "ENTREZID"])) 17 | GeneName <- data.frame( 18 | ENTREZID=target, 19 | SYMBOL=as.character(g$matching[target]), 20 | stringsAsFactors = FALSE) 21 | }else{ 22 | GeneName <- NULL 23 | } 24 | 25 | # GENENAME 26 | if("GENENAME" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 27 | message("Related gene descriptions are retrieved from AnnotationHub...") 28 | Description <- AnnotationDbi::select(ah, columns=c("GENENAME", "ENTREZID"), 29 | keytype="ENTREZID", keys=targetGeneID) 30 | Description <- Description[, c("ENTREZID", "GENENAME")] 31 | }else{ 32 | Description <- NULL 33 | } 34 | 35 | # GO 36 | if("GO" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 37 | message("Related GO IDs are retrieved from AnnotationHub...") 38 | GO <- AnnotationDbi::select(ah, columns=c("GO", "ENTREZID"), 39 | keytype="ENTREZID", keys=targetGeneID) 40 | GO <- GO[, c("ENTREZID", "GO")] 41 | }else{ 42 | GO <- NULL 43 | } 44 | 45 | # ENSG 46 | if("ENSEMBL" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 47 | message("Related Ensembl Gene IDs are retrieved from AnnotationHub...") 48 | ENSG <- AnnotationDbi::select(ah, columns=c("ENSEMBL", "ENTREZID"), 49 | keytype="ENTREZID", keys=targetGeneID) 50 | ENSG <- ENSG[, c("ENTREZID", "ENSEMBL")] 51 | }else{ 52 | ENSG <- NULL 53 | } 54 | 55 | # ENSP 56 | if("ENSEMBLPROT" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 57 | message("Related Ensembl Protein IDs are retrieved from AnnotationHub...") 58 | ENSP <- AnnotationDbi::select(ah, columns=c("ENSEMBLPROT", "ENTREZID"), 59 | keytype="ENTREZID", keys=targetGeneID) 60 | ENSP <- ENSP[, c("ENTREZID", "ENSEMBLPROT")] 61 | }else{ 62 | ENSP <- NULL 63 | } 64 | 65 | # UniProtKB 66 | if("UNIPROT" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 67 | message("Related UniProtKB IDs are retrieved from AnnotationHub...") 68 | UniProtKB <- AnnotationDbi::select(ah, columns=c("UNIPROT", "ENTREZID"), 69 | keytype="ENTREZID", keys=targetGeneID) 70 | UniProtKB <- UniProtKB[, c("ENTREZID", "UNIPROT")] 71 | }else if("UNIPROTID" %in% AnnotationDbi::columns(ah) && !is.null(ah)){ 72 | message("Related UniProtKB IDs are retrieved from AnnotationHub...") 73 | UniProtKB <- AnnotationDbi::select(ah, columns=c("UNIPROTID", "ENTREZID"), 74 | keytype="ENTREZID", keys=targetGeneID) 75 | UniProtKB <- UniProtKB[, c("ENTREZID", "UNIPROTID")] 76 | colnames(UniProtKB) <- c("ENTREZID", "UNIPROT") 77 | }else{ 78 | UniProtKB <- NULL 79 | } 80 | 81 | # MeSH 82 | ah <- AnnotationHub() 83 | mcah <- mcols(ah) 84 | msg <- gsub("LRBaseDb", "MeSHDb", ah[metadata(sce)$ahid]$title) 85 | ahid <- mcah@rownames[which(mcah@listData$title == msg)] 86 | if(length(ahid) != 0){ 87 | message(paste0("Related MeSH IDs are retrieved from ", 88 | "AnnotationHub...")) 89 | MeSHfile <- ah[[ahid]] 90 | MeSHobj <- MeSHDbi::MeSHDb(MeSHfile) 91 | MeSH <- MeSHDbi::select(MeSHobj, columns=c("MESHID", "GENEID"), 92 | keytype="GENEID", 93 | keys=targetGeneID) 94 | }else{ 95 | MeSH <- NULL 96 | } 97 | 98 | # Reactome 99 | Reactome <- toTable(reactomeEXTID2PATHID) 100 | targetReactome <- unlist(lapply(targetGeneID, 101 | function(x){which(Reactome$gene_id == x)})) 102 | if(length(targetReactome) != 0){ 103 | message(paste0("Related Reactome IDs are retrieved from ", 104 | "reactome.db package...")) 105 | Reactome <- Reactome[targetReactome, ] 106 | }else{ 107 | Reactome <- NULL 108 | } 109 | 110 | # Output 111 | list(GeneName=GeneName, Description=Description, GO=GO, 112 | ENSG=ENSG, ENSP=ENSP, UniProtKB=UniProtKB, 113 | Reactome=Reactome, MeSH=MeSH) 114 | } 115 | 116 | .geneInformation <- function(sce, ah, spc, LR){ 117 | targetGeneID <- as.character(unique(c(LR$GENEID_L, LR$GENEID_R))) 118 | if(!is.null(ah)){ 119 | # Gene Name 120 | message("Related gene names are retrieved from AnnotationHub...") 121 | GeneName <- AnnotationDbi::select(ah, columns=c("SYMBOL", "ENTREZID"), 122 | keytype="ENTREZID", keys=targetGeneID) 123 | GeneName <- unique(GeneName) 124 | nonna1 <- which(!is.na(GeneName[,1])) 125 | nonna2 <- which(!is.na(GeneName[,2])) 126 | GeneName <- GeneName[intersect(nonna1, nonna2), ] 127 | # Bipartite Matching 128 | g <- graph.data.frame(as.data.frame(GeneName), directed=FALSE) 129 | V(g)$type <- bipartite_mapping(g)$type 130 | g <- max_bipartite_match(g) 131 | target <- as.character(unique(GeneName[, "ENTREZID"])) 132 | GeneName <- data.frame( 133 | ENTREZID=target, 134 | SYMBOL=as.character(g$matching[target]), 135 | stringsAsFactors = FALSE) 136 | 137 | # Description 138 | message("Related gene descriptions are retrieved from AnnotationHub...") 139 | Description <- AnnotationDbi::select(ah, columns=c("GENENAME", "ENTREZID"), 140 | keytype="ENTREZID", keys=targetGeneID) 141 | Description <- Description[, c("ENTREZID", "GENENAME")] 142 | 143 | # GO 144 | message("Related GO IDs are retrieved from AnnotationHub...") 145 | GO <- AnnotationDbi::select(ah, columns=c("GO", "ENTREZID"), 146 | keytype="ENTREZID", keys=targetGeneID) 147 | GO <- GO[, c("ENTREZID", "GO")] 148 | 149 | # ENSG 150 | if(spc %in% c("Hsa", "Mmu", "Rno", "Cel", "Dre")){ 151 | message("Related Ensembl Gene IDs are retrieved from AnnotationHub...") 152 | ENSG <- AnnotationDbi::select(ah, columns=c("ENSEMBL", "ENTREZID"), 153 | keytype="ENTREZID", keys=targetGeneID) 154 | ENSG <- ENSG[, c("ENTREZID", "ENSEMBL")] 155 | }else{ 156 | ENSG <- NULL 157 | } 158 | 159 | # ENSP 160 | if(spc %ni% c("Ath", "Pab", "Xtr", "Ssc")){ 161 | message("Related Ensembl Protein IDs are retrieved from AnnotationHub...") 162 | ENSP <- AnnotationDbi::select(ah, columns=c("ENSEMBLPROT", "ENTREZID"), 163 | keytype="ENTREZID", keys=targetGeneID) 164 | ENSP <- ENSP[, c("ENTREZID", "ENSEMBLPROT")] 165 | }else{ 166 | ENSP <- NULL 167 | } 168 | 169 | # UniProtKB 170 | if(spc %ni% c("Ath", "Xtr")){ 171 | message("Related UniProtKB IDs are retrieved from AnnotationHub...") 172 | UniProtKB <- AnnotationDbi::select(ah, columns=c("UNIPROT", "ENTREZID"), 173 | keytype="ENTREZID", keys=targetGeneID) 174 | UniProtKB <- UniProtKB[, c("ENTREZID", "UNIPROT")] 175 | }else{ 176 | UniProtKB <- NULL 177 | } 178 | }else{ 179 | GeneName <- NULL 180 | Description <- NULL 181 | GO <- NULL 182 | ENSG <- NULL 183 | ENSP <- NULL 184 | UniProtKB <- NULL 185 | } 186 | 187 | # MeSH 188 | MeSHname <- paste0("MeSH.", gsub(".eg.db.sqlite", "", 189 | strsplit(metadata(sce)$lrbase, "LRBase.")[[1]][3]), ".eg.db") 190 | MeSH.load <- eval(parse(text=paste0("try(requireNamespace('", MeSHname, "', quietly=TRUE), silent=TRUE)"))) 191 | if(!MeSH.load){ 192 | eval(parse(text=paste0("try(BiocManager::install('", 193 | MeSHname, "', update=FALSE, ask=FALSE), silent=TRUE)"))) 194 | } 195 | MeSH.load2 <- eval(parse(text=paste0("try(require('", MeSHname, "', quietly=TRUE), silent=TRUE)"))) 196 | if(MeSH.load2){ 197 | eval(parse(text=paste0("library(", MeSHname, ")"))) 198 | message(paste0("Related MeSH IDs are retrieved from ", 199 | "MeSH.XXX.eg.db-type package...")) 200 | MeSHobj <- eval(parse(text=MeSHname)) 201 | MeSH <- MeSHDbi::select(MeSHobj, columns=c("MESHID", "GENEID"), 202 | keytype="GENEID", 203 | keys=targetGeneID) 204 | }else{ 205 | MeSH <- NULL 206 | } 207 | 208 | if(spc != "Pab"){ 209 | # Reactome 210 | message(paste0("Related Reactome IDs are retrieved from ", 211 | "reactome.db package...")) 212 | Reactome <- toTable(reactomeEXTID2PATHID) 213 | targetReactome <- unlist(lapply(targetGeneID, 214 | function(x){which(Reactome$gene_id == x)})) 215 | Reactome <- Reactome[targetReactome, ] 216 | }else{ 217 | Reactome <- NULL 218 | } 219 | # Output 220 | list(GeneName=GeneName, Description=Description, GO=GO, 221 | ENSG=ENSG, ENSP=ENSP, UniProtKB=UniProtKB, 222 | Reactome=Reactome, MeSH=MeSH) 223 | } 224 | -------------------------------------------------------------------------------- /R/scTensor-internal.R: -------------------------------------------------------------------------------- 1 | .CPMED <- function(input){ 2 | libsize <- colSums(input) 3 | median(libsize) * t(t(input) / libsize) 4 | } 5 | 6 | .CPM <- function(input){ 7 | libsize <- colSums(input) 8 | 1e6 * t(t(input) / libsize) 9 | } 10 | 11 | .CPT <- function(input){ 12 | libsize <- colSums(input) 13 | 1e4 * t(t(input) / libsize) 14 | } 15 | 16 | .FTT <- function(input){ 17 | sqrt(input) + sqrt(input + 1) 18 | } 19 | 20 | .importAssays <- function(sce, assayNames){ 21 | if(assayNames %in% names(assays(sce))){ 22 | eval(parse(text=paste0("assays(sce)$", assayNames))) 23 | }else{ 24 | stop("Please specify the valid assayNames (cf. names(assays(sce)))") 25 | } 26 | } 27 | 28 | '%ni%' <- Negate('%in%') 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![DOI](https://zenodo.org/badge/135140761.svg)](https://zenodo.org/badge/latestdoi/135140761) 2 | [![](https://img.shields.io/badge/release%20version-2.6.0-green.svg)](https://www.bioconductor.org/packages/release/bioc/html/scTensor.html) 3 | ![GitHub Actions](https://github.com/rikenbit/scTensor/actions/workflows/build_test_push.yml/badge.svg) 4 | 5 | # scTensor 6 | R package for detection of cell-cell interaction using Non-negative Tensor Decomposition 7 | 8 | Installation of Dependent Packages 9 | ====== 10 | ```r 11 | # CRAN 12 | install.packages(c("RSQLite", "igraph", "plotly", "nnTensor", 13 | "rTensor", "abind", "plotrix", "heatmaply", "tagcloud", 14 | "rmarkdown", "knitr", "outliers", "crayon", "checkmate", 15 | "testthat", "Seurat", "BiocManager"), 16 | repos="http://cran.r-project.org") 17 | 18 | # Bioconductor 19 | library("BiocManager") 20 | BiocManager::install(c("S4Vectors", "reactome.db", "AnnotationDbi", 21 | "SummarizedExperiment", "SingleCellExperiment", "BiocStyle", 22 | "biomaRt", "MeSHDbi", "Category", "meshr", "GOstats", "ReactomePA", 23 | "DOSE", "LRBase.Hsa.eg.db", "MeSH.Hsa.eg.db", "LRBase.Mmu.eg.db", 24 | "MeSH.Mmu.eg.db", "LRBaseDbi", "Homo.sapiens"), 25 | suppressUpdates=TRUE) 26 | ``` 27 | 28 | Installation 29 | ====== 30 | ```r 31 | git clone https://github.com/rikenbit/scTensor/ 32 | R CMD INSTALL scTensor 33 | ``` 34 | or type the code below in the R console window 35 | ```r 36 | install.packages("devtools", repos="http://cran.r-project.org") 37 | library(devtools) 38 | devtools::install_github("rikenbit/scTensor") 39 | ``` 40 | 41 | ## License 42 | Copyright (c) 2018 Koki Tsuyuzaki and Laboratory for Bioinformatics Research, RIKEN Center for Biosystems Dynamics Reseach 43 | Released under the [Artistic License 2.0](http://www.perlfoundation.org/artistic_license_2_0). 44 | 45 | ## Authors 46 | - Koki Tsuyuzaki 47 | - Manabu Ishii 48 | - Itoshi Nikaido -------------------------------------------------------------------------------- /data/GermMale.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/data/GermMale.rda -------------------------------------------------------------------------------- /data/labelGermMale.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/data/labelGermMale.rda -------------------------------------------------------------------------------- /data/m.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/data/m.rda -------------------------------------------------------------------------------- /data/tsneGermMale.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/data/tsneGermMale.rda -------------------------------------------------------------------------------- /data/v.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/data/v.rda -------------------------------------------------------------------------------- /inst/NEWS: -------------------------------------------------------------------------------- 1 | VERSION 2.18.1 2 | ------------------------ 3 | o A vignette modified. 4 | 5 | VERSION 2.4.1 6 | ------------------------ 7 | o A vignette modified. 8 | 9 | VERSION 2.4.0 10 | ------------------------ 11 | o Regularizer parameter (L2_A/L1_A) was added in cellCellDecomp() ("ntd", "ntd2"). 12 | o Multilinear CX Decompotision was added in cellCellDecomp() ("cx"). 13 | o convertNCBIGeneID is removed. 14 | o The vignettes were modified. 15 | o Support of LRBase.XXX.eg.db-type packages is completely deprecated 16 | 17 | VERSION 2.0.0 18 | ------------------------ 19 | o Extended to use the version 2.0.0 of LRBase.XXX.eg.db-type packages 20 | o Omitted typing Enter-key many times to perform example('cellCellReport') 21 | o lr.evidence option was added in cellCellRanks() and cellCellDecomp() to select ligand-receptor databases to construct CCI-tensor (cf. Evidence code: https://github.com/rikenbit/lrbase-workflow) 22 | o The L-R evidence was embeded in the HTML report. 23 | o The bug related to the hyper-link was fixed in .hyperLinks. 24 | o Auto library installation/loading for MeSH.XXX.eg.db. Note that this function is based on the NCBI Taxonomy ID embedded in METATDATA table in the sqlite3 file of LRBase.XXX.eg.db. 25 | o The order of the parameters of cellCellSetting were changed as cellCellSetting(sce, lrbase, label, lr.evidence="all", color=NULL), and color parameter was changed as a optional parameter. If it is not specified, the color is automatically selected. 26 | o The way to specify the celltype label was changed in cellCellSetting. 27 | o The vignettes were modified. 28 | o The convertNCBIGeneID is deprecated. The same functionality can be available as scTGIF::convertRowID instead. 29 | 30 | VERSION 1.4.1-3 31 | ------------------------ 32 | o A bug was fixed in .cellCellDecomp.Halpern() 33 | 34 | VERSION 1.4.0 (Bioconductor 3.11) 35 | ------------------------ 36 | o verbose parameter was added in cellCellRank() and cellCellDecomp() 37 | o set.seed(1234) was added in example and vignette 38 | o .cellCellDecomp.CabelloAguilar() and .cellCellDecomp.Halpern() were added 39 | o The num.iter 300　of NTD was changed to 30 40 | o schex package was imported for visualing all the two dimensional gene plots 41 | o The rule of cellCellRanks() based on the singular value of SVD was changed to a reconstruction error based rule, using NMF with matricised tensor in each mode 42 | o The CCI-tensor is normalized in each frontral slice so that the total value is 1 (.frontal.normalization) 43 | 44 | VERSION 1.2.1 45 | ------------------------ 46 | o Some bugs were fixed 47 | 48 | VERSION 1.2.0 (Bioconductor 3.10) 49 | ------------------------ 50 | o goenrich, meshenrich, reactomeenrich, doenrich, ncgenrich, and dgnenrich in cellCellReport() were added 51 | o A bug related in sparse matrix in cellCellSetting() was fixed 52 | o All the vignettes were updated 53 | o A vignette for reanalysis of the results of scTensor was added 54 | o Some bugs were fixed 55 | 56 | VERSION 1.0.13 57 | ------------------------ 58 | o Gene-gene network based on visNetwork was introduced 59 | 60 | VERSION 1.0.11 - 1.0.12 61 | ------------------------ 62 | o Some bugs were fixed 63 | 64 | VERSION 1.0.10 65 | ------------------------ 66 | o The tensor decomposition model was changed from non-negative Tucker3 to non-negative Tucker2 67 | o assayNames option was added to specify which normalized assay data user want to use 68 | o ftt option was removed (any normalization can be performed instead) 69 | 70 | VERSION 1.0.7 - 1.0.9 71 | ------------------------ 72 | o Some bugs were fixed 73 | 74 | VERSION 1.0.6 75 | ------------------------ 76 | o Replaced Dependency against biomaRt by AnnotationHub 77 | 78 | VERSION 1.0.3 - 1.0.5 79 | ------------------------ 80 | o Some bugs were fixed 81 | 82 | VERSION 1.0.2 83 | ------------------------ 84 | o Added upper in cellCellReport() 85 | o Table grid lines in {ligand,receptor}*.Rmd were added 86 | o Some bugs were fixed 87 | 88 | VERSION 1.0.1 89 | ------------------------ 90 | o Some bugs were fixed 91 | o Three vignettes were added 92 | o convertToNCBIGeneID() to ID conversion of input matrix 93 | 94 | VERSION 1.0.0 (Bioconductor 3.9) 95 | ------------------------ 96 | o Package release 97 | 98 | VERSION 0.99.22 99 | ------------------------ 100 | o newCCSParams(), getParam(), setParam(), and cellCellSimulate() were added 101 | o The hyperlinks to CMap (Connectivity Map) were embedded in the HTML report 102 | 103 | VERSION 0.99.21 104 | ------------------------ 105 | o Some bugs were fixed 106 | 107 | VERSION 0.99.18 108 | ------------------------ 109 | o Added Enrichment Analysis in cellCellReport() 110 | 111 | VERSION 0.99.15 112 | ------------------------ 113 | o Accepted in BioC 3.9 114 | 115 | VERSION 0.99.6 to 0.99.14 116 | ------------------------ 117 | o Revised and modified some parts 118 | 119 | VERSION 0.99.0 120 | ------------------------ 121 | o Package released -------------------------------------------------------------------------------- /inst/extdata/Workflow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/inst/extdata/Workflow.png -------------------------------------------------------------------------------- /inst/extdata/Workflow_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/inst/extdata/Workflow_2.png -------------------------------------------------------------------------------- /man/CCSParams-class.Rd: -------------------------------------------------------------------------------- 1 | \name{CCSParams-class} 2 | \docType{class} 3 | \alias{CCSParams-class} 4 | \title{Class "CCSParams"} 5 | 6 | \description{ 7 | The parameter object to be specified against cellCellSimulate function. 8 | } 9 | 10 | \section{Objects from the Class}{ 11 | Objects can be created by calls of the form \code{new("CCSParams", ...)}. 12 | } 13 | 14 | \section{Slots}{ 15 | \describe{ 16 | \item{nGene:}{The number of genes.} 17 | \item{nCell:}{The number of cells.} 18 | \item{cciInfo:}{The parameter to describe the CCI.} 19 | \item{lambda:}{The parameter for dropout simulation.} 20 | \item{seed:}{The seed for using random numbers.} 21 | } 22 | } 23 | 24 | \section{Methods}{ 25 | \describe{ 26 | \item{newCCSParams}{Generator of CCSParams object.} 27 | \item{getParam}{Getter function of the slot in CCSParams object.} 28 | \item{setParam<-}{Setter function of the slot in CCSParams object.} 29 | } 30 | } 31 | 32 | \seealso{ 33 | \code{\link{newCCSParams}}, \code{\link{getParam}}, \code{\link{setParam<-}} 34 | } 35 | 36 | \keyword{classes} 37 | -------------------------------------------------------------------------------- /man/GermMale.Rd: -------------------------------------------------------------------------------- 1 | \name{GermMale} 2 | \alias{GermMale} 3 | \docType{data} 4 | \title{ 5 | The matrix which is used as test data of scTensor. 6 | } 7 | \description{ 8 | A matrix with 242 rows (genes) * 852 columns (cells). 9 | } 10 | \usage{data(GermMale)} 11 | \details{ 12 | The data matrix is downloaded from GEO Series GSE86146 13 | (https://www.ncbi.nlm.nih.gov/geo/download/?acc=GSE86146&format=file). 14 | Only male data is extracted and then the gene symbol is converted to 15 | NCBI Gene ID by Homo.sapiens package. 16 | 17 | For saving the package size, the number of genes are strictlly reduced by the 18 | standard of highlly variable genes with threshold of p-value is 1E-300. 19 | } 20 | \references{ 21 | Li L. and Dong J. and Yan L. and Yong J. et al. (2017) 22 | Single-Cell RNA-Seq Analysis Maps Development of Human Germline Cells 23 | and Gonadal Niche Interactions. \emph{Cell Stem Cell}, \bold{20(6)}: 858-873 24 | } 25 | \seealso{ 26 | \code{\link{labelGermMale}}, \code{\link{tsneGermMale}}. 27 | } 28 | \examples{ 29 | data(GermMale) 30 | } 31 | \keyword{datasets} -------------------------------------------------------------------------------- /man/cellCellDecomp.Rd: -------------------------------------------------------------------------------- 1 | \name{cellCellDecomp} 2 | \docType{methods} 3 | \alias{cellCellDecomp,SingleCellExperiment-method} 4 | \alias{cellCellDecomp} 5 | 6 | \title{ 7 | Performing scTensor 8 | } 9 | \description{ 10 | All parameters is saved to metadata slot of SingleCellExperiment object. 11 | } 12 | \usage{ 13 | cellCellDecomp(sce, algorithm=c("ntd2", "ntd", "nmf", "cx", "pearson", 14 | "spearman", "distance", "pearson.lr", "spearman.lr", "distance.lr", 15 | "pcomb", "label.permutation", "cabello.aguilar", "halpern"), ranks=c(3,3), rank=3, thr1=log2(5), thr2=25, thr3=0.95, L1_A=0, L2_A=0, verbose=FALSE, 16 | centering=TRUE, mergeas=c("mean", "sum"), outerfunc=c("*", "+"), 17 | comb=c("random", "all"), num.sampling=100, num.perm=1000, assayNames = "counts", decomp=TRUE) 18 | } 19 | 20 | \arguments{ 21 | \item{sce}{ 22 | The object generated by instantization of SingleCellExperiment-class. 23 | } 24 | \item{algorithm}{ 25 | Algorithm for constrcting cell-cell similarity matrix. 26 | "ntd2", "ntd", "nmf", "cx", "pearson", "spearman", "distance", 27 | "pearson.lr", "spearman.lr", "distance.lr", "pcomb" or "label.permutation" 28 | can be specified (Default: ntd2). 29 | } 30 | \item{ranks}{ 31 | The size of the core tensor decomposed by NTD. 32 | Each element means (Number of Ligand-Cell Pattern, 33 | Number of Receptor-Cell Pattern, Number of LR-pairs Pattern) 34 | (Default: c(3,3)). 35 | } 36 | \item{rank}{ 37 | The number of low dimension of NMF (Default: 3). 38 | } 39 | \item{thr1}{ 40 | The threshold used by pcomb (Default: log2(5)). 41 | } 42 | \item{thr2}{ 43 | The threshold used by pcomb (Default: 25). 44 | } 45 | \item{thr3}{ 46 | The threshold used by cx (Default: 0.95). 47 | } 48 | \item{L1_A}{ 49 | The parameter to control the sparseness (Default: 0). 50 | } 51 | \item{L2_A}{ 52 | The parameter to control the outlier (Default: 0). 53 | } 54 | \item{verbose}{ 55 | The verbose parameter for nnTensor::NTD (Default: FALSE). 56 | } 57 | \item{centering}{ 58 | When the value is TRUE, input matrix is summarized as celltype-level vectors 59 | (Default: TRUE). 60 | } 61 | \item{mergeas}{ 62 | When the centering is TRUE, "sum" (celltype-level sum vector) 63 | or "mean" (celltype-level average vector) is calculated (Default: "sum"). 64 | } 65 | \item{outerfunc}{ 66 | When the centering is TRUE, "+" (Kronecker sum) or "*" (Kronecker product) 67 | is calculated (Default: "+"). 68 | } 69 | \item{comb}{ 70 | When the centering is FALSE, "random" (random cell-cell pairing) 71 | or "all" (all possible cell-cell pairing) is calculed (Default: "random"). 72 | } 73 | \item{num.sampling}{ 74 | The number of random sampling used (Default: 100). 75 | } 76 | \item{num.perm}{ 77 | The number of the permutation in label permutation test (Default: 1000). 78 | } 79 | \item{assayNames}{ 80 | The unit of gene expression for using scTensor (e.g. normcounts, cpm...etc) (Default: "counts"). 81 | } 82 | \item{decomp}{ 83 | When the value is TRUE, cell-cell interaction tensor is decomposed 84 | (Default: TRUE). 85 | } 86 | } 87 | 88 | \value{ 89 | The result is saved to metadata slot of SingleCellExperiment object. 90 | } 91 | \seealso{ 92 | \code{\link[SingleCellExperiment]{SingleCellExperiment}}. 93 | } 94 | 95 | \author{Koki Tsuyuzaki} 96 | 97 | \examples{ 98 | showMethods("cellCellDecomp") 99 | } 100 | 101 | \keyword{methods} -------------------------------------------------------------------------------- /man/cellCellRanks.Rd: -------------------------------------------------------------------------------- 1 | \name{cellCellRanks} 2 | \docType{methods} 3 | \alias{cellCellRanks,SingleCellExperiment-method} 4 | \alias{cellCellRanks} 5 | 6 | \title{ 7 | Rank estimation of the CCI-tensor 8 | } 9 | \description{ 10 | SVD is performed in each mode. 11 | } 12 | \usage{ 13 | cellCellRanks(sce, centering=TRUE, 14 | mergeas=c("mean", "sum"), outerfunc=c("*", "+"), comb=c("random", "all"), 15 | num.sampling=100, num.perm=1000, assayNames = "counts", verbose=FALSE, 16 | num.iter1=5, num.iter2=5, num.iter3=NULL) 17 | } 18 | 19 | \arguments{ 20 | \item{sce}{ 21 | A object generated by instantization of SingleCellExperiment-class. 22 | } 23 | \item{centering}{ 24 | When the value is TRUE, input matrix is summarized as celltype-level vectors 25 | (Default: TRUE). 26 | } 27 | \item{mergeas}{ 28 | When the centering is TRUE, "mean" (celltype-level mean vector) 29 | or "sum" (celltype-level sum vector) is calculated (Default: "mean"). 30 | } 31 | \item{outerfunc}{ 32 | When the centering is TRUE, "*" (Kronecker product) or "+" (Kronecker sum) or is calculated (Default: "+"). 33 | } 34 | \item{comb}{ 35 | When the centering is FALSE, "random" (random cell-cell pairing) 36 | or "all" (all possible cell-cell pairing) is calculed (Default: "random"). 37 | } 38 | \item{num.sampling}{ 39 | The number of random sampling used (Default: 100). 40 | } 41 | \item{num.perm}{ 42 | The number of the permutation in label permutation test (Default: 1000). 43 | } 44 | \item{assayNames}{ 45 | The unit of gene expression for using scTensor (e.g. normcounts, cpm...etc) (Default: "counts"). 46 | } 47 | \item{verbose}{ 48 | The verbose parameter for nnTensor::NTD (Default: FALSE). 49 | } 50 | \item{num.iter1}{ 51 | The number of iteration to estimate the rank of mode-1 matricised data tensor (Default: 5). 52 | } 53 | \item{num.iter2}{ 54 | The number of iteration to estimate the rank of mode-2 matricised data tensor (Default: 5). 55 | } 56 | \item{num.iter3}{ 57 | The number of iteration to estimate the rank of mode-3 matricised data tensor (Default: NULL). 58 | } 59 | } 60 | 61 | \value{ 62 | RSS: A list with three elements, in which each element means the average reconstructed error in each rank. 63 | selected: A vector with three elements, in which each element means the estimated ranks in mode-1, 2 and 3 matricization. 64 | } 65 | \seealso{ 66 | \code{\link[SingleCellExperiment]{SingleCellExperiment}}. 67 | } 68 | 69 | \author{Koki Tsuyuzaki} 70 | 71 | \examples{ 72 | showMethods("cellCellRanks") 73 | } 74 | 75 | \keyword{methods} -------------------------------------------------------------------------------- /man/cellCellReport.Rd: -------------------------------------------------------------------------------- 1 | \name{cellCellReport} 2 | \docType{methods} 3 | \alias{cellCellReport,SingleCellExperiment-method} 4 | \alias{cellCellReport} 5 | 6 | \title{ 7 | HTML report of the result of scTensor 8 | } 9 | \description{ 10 | The result is saved as HTML report which contains with multiple files. 11 | } 12 | \usage{ 13 | cellCellReport(sce, reducedDimNames, 14 | out.dir=tempdir(), html.open=FALSE, 15 | title="The result of scTensor", 16 | author="The person who runs this script", assayNames = "counts", thr=100, 17 | top="full", p=0.05, upper=20, 18 | goenrich=TRUE, meshenrich=TRUE, reactomeenrich=TRUE, 19 | doenrich=TRUE, ncgenrich=TRUE, dgnenrich=TRUE, nbins=40) 20 | } 21 | 22 | \arguments{ 23 | \item{sce}{ 24 | A object generated by instantization of SingleCellExperiment-class. 25 | } 26 | \item{reducedDimNames}{ 27 | The name of two-dimentional data saved in reducedDimNames slot of 28 | SingleCellExperiment object. 29 | } 30 | \item{out.dir}{ 31 | The output directory for saving HTML report (out.dir: tempdir()). 32 | } 33 | \item{html.open}{ 34 | Whether the result of HTML report is opened when the calculation is finished 35 | (Default: FALSE). 36 | } 37 | \item{title}{ 38 | The title of HTML report (Default: "The result of scTensor"). 39 | } 40 | \item{author}{ 41 | The author of HTML report (Default: "The person who runs this script"). 42 | } 43 | \item{assayNames}{ 44 | The unit of gene expression for using scTensor (e.g. normcounts, cpm...etc) (Default: "counts"). 45 | } 46 | \item{thr}{ 47 | The threshold for selection of top pecentage of core tensor elements 48 | (Default: 100 (1 to 100)). 49 | } 50 | \item{top}{ 51 | top genes in each (*,*,*)-pattern which are selected and summarized in the report (Default: "full") 52 | } 53 | \item{p}{ 54 | The threshold of p-value of the enrichment analysis (Default: 1E-2) 55 | } 56 | \item{upper}{ 57 | The maxium number of HTML reports generates (Default: 20) 58 | } 59 | \item{goenrich}{ 60 | Whether GO-Enrichment analysis is performed (Default: TRUE) 61 | } 62 | \item{meshenrich}{ 63 | Whether MeSH-Enrichment analysis is performed (Default: TRUE) 64 | } 65 | \item{reactomeenrich}{ 66 | Whether Reactome-Enrichment analysis is performed (Default: TRUE) 67 | } 68 | \item{doenrich}{ 69 | Whether DO-Enrichment analysis is performed (Default: TRUE) 70 | } 71 | \item{ncgenrich}{ 72 | Whether NCG-Enrichment analysis is performed (Default: TRUE) 73 | } 74 | \item{dgnenrich}{ 75 | Whether DGN-Enrichment analysis is performed (Default: TRUE) 76 | } 77 | \item{nbins}{ 78 | The number of bins used for the two dimensional plot of schex (Default: 40) 79 | } 80 | } 81 | 82 | \value{ 83 | The result is saved as HTML report which contains with multiple files. 84 | } 85 | \seealso{ 86 | \code{\link[SingleCellExperiment]{SingleCellExperiment}}. 87 | } 88 | 89 | \author{Koki Tsuyuzaki} 90 | 91 | \examples{ 92 | if(interactive()){ 93 | # Package Loading 94 | library("SingleCellExperiment") 95 | library("AnnotationHub") 96 | if(!require(LRBaseDbi)){ 97 | BiocManager::install("LRBaseDbi") 98 | library(LRBaseDbi) 99 | } 100 | ah <- AnnotationHub() 101 | dbfile <- query(ah, c("LRBaseDb", "Homo sapiens", "v002"))[[1]] 102 | LRBase.Hsa.eg.db <- LRBaseDbi::LRBaseDb(dbfile) 103 | 104 | # Data Loading 105 | data(GermMale) 106 | data(labelGermMale) 107 | data(tsneGermMale) 108 | 109 | # SingleCellExperiment Object 110 | sce <- SingleCellExperiment(assays=list(counts = GermMale)) 111 | reducedDims(sce) <- SimpleList(TSNE=tsneGermMale$Y) 112 | 113 | # User's Original Normalization Function 114 | CPMED <- function(input){ 115 | libsize <- colSums(input) 116 | median(libsize) * t(t(input) / libsize) 117 | } 118 | # Normalization 119 | normcounts(sce) <- log10(CPMED(counts(sce)) + 1) 120 | 121 | # Registration of required information into metadata(sce) 122 | cellCellSetting(sce, LRBase.Hsa.eg.db, names(labelGermMale)) 123 | 124 | # Rank Estimation 125 | rks <- cellCellRanks(sce, assayNames="normcounts") 126 | 127 | # CCI Tensor Decomposition 128 | set.seed(1234) 129 | cellCellDecomp(sce, ranks=rks$selected, assayNames="normcounts") 130 | 131 | # HTML Report 132 | options(device.ask.default = FALSE) 133 | cellCellReport(sce, reducedDimNames="TSNE", 134 | out.dir=tempdir(), html.open=FALSE, 135 | title="The result of scTensor", 136 | author="The person who runs this script", 137 | assayNames="counts", thr=100, 138 | top="full", p=0.05, upper=20, 139 | goenrich=TRUE, meshenrich=TRUE, reactomeenrich=TRUE, 140 | doenrich=TRUE, ncgenrich=TRUE, dgnenrich=TRUE, nbins=40) 141 | }else{ 142 | showMethods("cellCellReport") 143 | } 144 | } 145 | 146 | \keyword{methods} -------------------------------------------------------------------------------- /man/cellCellSetting.Rd: -------------------------------------------------------------------------------- 1 | \name{cellCellSetting} 2 | \docType{methods} 3 | \alias{cellCellSetting,SingleCellExperiment-method} 4 | \alias{cellCellSetting} 5 | 6 | \title{ 7 | Parameter setting for scTensor 8 | } 9 | \description{ 10 | All parameters is saved to metadata slot of SingleCellExperiment object. 11 | } 12 | \usage{ 13 | cellCellSetting(sce, lrbase, label, lr.evidence="known", color=NULL) 14 | } 15 | 16 | \arguments{ 17 | \item{sce}{ 18 | A object generated by instantization of SingleCellExperiment-class. 19 | } 20 | \item{lrbase}{ 21 | Ligand-Receptor database (LRBase.XXX.eg.db-type package). 22 | } 23 | \item{label}{ 24 | Cellular label information for distingusishing 25 | which cells belong to common celltypes. 26 | } 27 | \item{lr.evidence}{ 28 | The evidence code for L-R pair list (Default: "known"). 29 | When you specify "known", DLRP, IUPHAR, HPMR, CELLPHONEDB, SINGLECELLSIGNALR are searched, and other databases are searched, when you specify "putative". 30 | You can also specify multiple databases at once (e.g. c("SWISSPROT_STRING", "TREMBL_STRING")). 31 | cf. https://github.com/rikenbit/lrbase-workflow 32 | } 33 | \item{color}{ 34 | Color scheme for adding color against the cells (Default: NULL). 35 | If the value is not specified, automatically the color vector is generated. 36 | } 37 | } 38 | 39 | \value{ 40 | The result is saved to metadata slot of SingleCellExperiment object. 41 | } 42 | \seealso{ 43 | \code{\link[SingleCellExperiment]{SingleCellExperiment}}. 44 | } 45 | 46 | \author{Koki Tsuyuzaki} 47 | 48 | \examples{ 49 | showMethods("cellCellSetting") 50 | } 51 | 52 | \keyword{methods} -------------------------------------------------------------------------------- /man/cellCellSimulate.Rd: -------------------------------------------------------------------------------- 1 | \name{cellCellSimulate} 2 | \docType{methods} 3 | \alias{cellCellSimulate,SingleCellExperiment-method} 4 | \alias{cellCellSimulate} 5 | 6 | \title{ 7 | Parameter Simulate for scTensor 8 | } 9 | \description{ 10 | All parameters is saved to metadata slot of SingleCellExperiment object. 11 | } 12 | \usage{ 13 | cellCellSimulate(params = newCCSParams(), verbose = TRUE) 14 | } 15 | 16 | \arguments{ 17 | \item{params}{ 18 | A parameter object generated by newCCSParams(). 19 | } 20 | \item{verbose}{ 21 | Whether the message is outputted or not (Default: TRUE). 22 | } 23 | } 24 | 25 | \value{ 26 | A list object containing simcount, LR, and celltype. 27 | simcount is the synthetic count matrix, LR is the synthetic ligand-receptor pair list, and celltype is the vector to specity the celltype of the each column of simcount. 28 | } 29 | 30 | \author{Koki Tsuyuzaki} 31 | 32 | \examples{ 33 | showMethods("cellCellSimulate") 34 | } 35 | 36 | \keyword{methods} -------------------------------------------------------------------------------- /man/getParam.Rd: -------------------------------------------------------------------------------- 1 | \docType{methods} 2 | \name{getParam} 3 | \alias{getParam} 4 | \alias{getParam,CCSParams-method} 5 | \title{Get a parameter} 6 | \usage{ 7 | getParam(object, name) 8 | 9 | \S4method{getParam}{CCSParams}(object, name) 10 | } 11 | \arguments{ 12 | \item{object}{object to get parameter from.} 13 | 14 | \item{name}{name of the parameter to get.} 15 | } 16 | \value{ 17 | The extracted parameter value 18 | } 19 | \description{ 20 | Accessor function for getting parameter values. 21 | } 22 | \examples{ 23 | params <- newCCSParams() 24 | 25 | getParam(params, "nGene") 26 | getParam(params, "nCell") 27 | getParam(params, "cciInfo") 28 | getParam(params, "lambda") 29 | getParam(params, "seed") 30 | } -------------------------------------------------------------------------------- /man/labelGermMale.Rd: -------------------------------------------------------------------------------- 1 | \name{labelGermMale} 2 | \alias{labelGermMale} 3 | \docType{data} 4 | \title{ 5 | The vector contains the celltype information and color scheme of GermMale 6 | } 7 | \description{ 8 | A vector with 852 length (cells). 9 | } 10 | \usage{data(labelGermMale)} 11 | \details{ 12 | The Cluster label is downloaded from original paper page of Cell Stem Cell 13 | (https://www.sciencedirect.com/science/article/pii/S1934590917300784) 14 | } 15 | \references{ 16 | Li L. and Dong J. and Yan L. and Yong J. et al. (2017) 17 | Single-Cell RNA-Seq Analysis Maps Development of Human Germline Cells 18 | and Gonadal Niche Interactions. \emph{Cell Stem Cell}, \bold{20(6)}: 858-873 19 | } 20 | \seealso{ 21 | \code{\link{GermMale}}, \code{\link{tsneGermMale}}. 22 | } 23 | \examples{ 24 | data(labelGermMale) 25 | } 26 | \keyword{datasets} -------------------------------------------------------------------------------- /man/m.Rd: -------------------------------------------------------------------------------- 1 | \name{m} 2 | \alias{m} 3 | \docType{data} 4 | \title{ 5 | The gene-wise mean vector of Quartz-Seq data. 6 | } 7 | \description{ 8 | This data is internally used in cellCellSimulate function. 9 | } 10 | \usage{data(m)} 11 | \examples{ 12 | data(m) 13 | } 14 | \keyword{datasets} -------------------------------------------------------------------------------- /man/newCCSParams.Rd: -------------------------------------------------------------------------------- 1 | \name{newCCSParams} 2 | \alias{newCCSParams} 3 | \title{New Params} 4 | \usage{ 5 | newCCSParams() 6 | } 7 | \arguments{ 8 | \item{}{Nothing.} 9 | } 10 | \value{ 11 | New Params object. 12 | } 13 | \description{ 14 | Create a new CCSParams object. 15 | } 16 | \examples{ 17 | params <- newCCSParams() 18 | } -------------------------------------------------------------------------------- /man/scTensor-package.Rd: -------------------------------------------------------------------------------- 1 | \name{scTensor-package} 2 | \alias{scTensor-package} 3 | \alias{scTensor} 4 | \docType{package} 5 | \title{ 6 | \packageTitle{scTensor} 7 | } 8 | \description{ 9 | \packageDescription{scTensor} 10 | } 11 | \details{ 12 | 13 | The DESCRIPTION file: 14 | \packageDESCRIPTION{scTensor} 15 | \packageIndices{scTensor} 16 | } 17 | \author{ 18 | \packageAuthor{scTensor} 19 | 20 | Maintainer: \packageMaintainer{scTensor} 21 | } 22 | 23 | \keyword{ package } 24 | \seealso{\code{\link{GermMale}},\code{\link{labelGermMale}}, 25 | \code{\link{tsneGermMale}},\code{\link{cellCellSetting}}, 26 | \code{\link{cellCellDecomp}},\code{\link{cellCellReport}}} 27 | \examples{ 28 | ls("package:scTensor") 29 | } -------------------------------------------------------------------------------- /man/setParam.Rd: -------------------------------------------------------------------------------- 1 | \docType{methods} 2 | \name{setParam} 3 | \alias{setParam} 4 | \alias{setParam<-} 5 | \alias{setParam,CCSParams-method} 6 | \alias{setParam<-,CCSParams-method} 7 | \alias{setParam,CCSParams,ANY-method} 8 | \alias{setParam<-,CCSParams,ANY-method} 9 | \title{Set a parameter} 10 | \usage{ 11 | setParam(object, name) <- value 12 | \S4method{setParam}{CCSParams}(object, name, value) 13 | } 14 | \arguments{ 15 | \item{object}{object to set parameter in.} 16 | 17 | \item{name}{name of the parameter to set.} 18 | 19 | \item{value}{value to set the paramter to.} 20 | } 21 | \value{ 22 | Object with new parameter value. 23 | } 24 | \description{ 25 | Function for setting parameter values. 26 | } 27 | \examples{ 28 | params <- newCCSParams() 29 | 30 | setParam(params, "nGene") <- 20000 31 | setParam(params, "nCell") <- c(12, 43, 323) 32 | setParam(params, "cciInfo") <- list(nPair=2000, 33 | CCI1=list( 34 | LPattern=c(1,0,0), 35 | RPattern=c(0,1,1), 36 | nGene=100, 37 | fc="E10"), 38 | CCI2=list( 39 | LPattern=c(0,0,1), 40 | RPattern=c(1,1,1), 41 | nGene=200, 42 | fc="E10"), 43 | CCI3=list( 44 | LPattern=c(1,1,1), 45 | RPattern=c(1,0,1), 46 | nGene=300, 47 | fc="E10") 48 | ) 49 | setParam(params, "lambda") <- 0.1 50 | setParam(params, "seed") <- 111 51 | } -------------------------------------------------------------------------------- /man/tsneGermMale.Rd: -------------------------------------------------------------------------------- 1 | \name{tsneGermMale} 2 | \alias{tsneGermMale} 3 | \docType{data} 4 | \title{ 5 | The result of Rtsne against GermMale 6 | } 7 | \description{ 8 | A List contains some parameters and the result of Rtsne function. 9 | } 10 | \usage{data(tsneGermMale)} 11 | \details{ 12 | Rtsne is performed as follows. 13 | 14 | library(Rtsne) 15 | set.seed(123) 16 | tsneGermMale <- Rtsne(dist(t(GermMale)), is_distance=TRUE, perplexity=40) 17 | } 18 | \references{ 19 | Li L. and Dong J. and Yan L. and Yong J. et al. (2017) Single-Cell RNA-Seq 20 | Analysis Maps Development of Human Germline Cells and Gonadal Niche 21 | Interactions. \emph{Cell Stem Cell}, \bold{20(6)}: 858-873 22 | } 23 | \seealso{ 24 | \code{\link{labelGermMale}}, \code{\link{GermMale}}. 25 | } 26 | \examples{ 27 | data(tsneGermMale) 28 | } 29 | \keyword{datasets} -------------------------------------------------------------------------------- /man/v.Rd: -------------------------------------------------------------------------------- 1 | \name{v} 2 | \alias{v} 3 | \docType{data} 4 | \title{ 5 | The gene-wise variance vector of Quartz-Seq data. 6 | } 7 | \description{ 8 | This data is internally used in cellCellSimulate function. 9 | } 10 | \usage{data(v)} 11 | \examples{ 12 | data(v) 13 | } 14 | \keyword{datasets} -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library("testthat") 2 | library("scTensor") 3 | 4 | options(testthat.use_colours = FALSE) 5 | 6 | test_file("testthat/test_GermMale.R") 7 | test_file("testthat/test_tsneGermMale.R") 8 | test_file("testthat/test_labelGermMale.R") 9 | test_file("testthat/test_cellCellFunctions.R") 10 | test_file("testthat/test_CCSParamsFunctions.R") 11 | -------------------------------------------------------------------------------- /tests/testthat/test_CCSParamsFunctions.R: -------------------------------------------------------------------------------- 1 | context("CCSParamsFunctions") 2 | 3 | # newCCSParams 4 | params <- newCCSParams() 5 | expect_true(class(params) =="CCSParams") 6 | 7 | # getParam 8 | expect_true(is.numeric(getParam(params, "nGene"))) 9 | expect_true(is.numeric(getParam(params, "nCell"))) 10 | expect_true(is.list(getParam(params, "cciInfo"))) 11 | expect_true(is.numeric(getParam(params, "lambda"))) 12 | expect_true(is.numeric(getParam(params, "seed"))) 13 | 14 | # setParam 15 | setParam(params, "nGene") <- 20000 16 | expect_true(identical(getParam(params, "nGene"), 20000)) 17 | 18 | setParam(params, "nCell") <- c(12, 43, 323) 19 | expect_true(identical(getParam(params, "nCell"), c(12, 43, 323))) 20 | 21 | setParam(params, "cciInfo") <- list(nPair=2000, 22 | CCI1=list( 23 | LPattern=c(1,0,0), 24 | RPattern=c(0,1,1), 25 | nGene=200, 26 | fc="E10"), 27 | CCI2=list( 28 | LPattern=c(0,0,1), 29 | RPattern=c(1,1,1), 30 | nGene=200, 31 | fc="E10"), 32 | CCI3=list( 33 | LPattern=c(1,1,1), 34 | RPattern=c(1,0,1), 35 | nGene=200, 36 | fc="E10") 37 | ) 38 | expect_true(identical(getParam(params, "cciInfo"), 39 | list(nPair=2000, 40 | CCI1=list( 41 | LPattern=c(1,0,0), 42 | RPattern=c(0,1,1), 43 | nGene=200, 44 | fc="E10"), 45 | CCI2=list( 46 | LPattern=c(0,0,1), 47 | RPattern=c(1,1,1), 48 | nGene=200, 49 | fc="E10"), 50 | CCI3=list( 51 | LPattern=c(1,1,1), 52 | RPattern=c(1,0,1), 53 | nGene=200, 54 | fc="E10") 55 | ))) 56 | 57 | setParam(params, "lambda") <- 0.1 58 | expect_true(identical(getParam(params, "lambda"), 0.1)) 59 | 60 | setParam(params, "seed") <- 123 61 | expect_true(identical(getParam(params, "seed"), 123)) 62 | -------------------------------------------------------------------------------- /tests/testthat/test_GermMale.R: -------------------------------------------------------------------------------- 1 | context("GermMale") 2 | 3 | data(GermMale) 4 | 5 | expect_equivalent(dim(GermMale), c(2547, 852)) 6 | -------------------------------------------------------------------------------- /tests/testthat/test_cellCellFunctions.R: -------------------------------------------------------------------------------- 1 | context("cellCellFunctions") 2 | 3 | library(SingleCellExperiment) 4 | library(LRBase.Hsa.eg.db) 5 | 6 | data(GermMale) 7 | data(labelGermMale) 8 | data(tsneGermMale) 9 | 10 | # SingleCellExperiment-class 11 | sce <- SingleCellExperiment(assays = list(counts = GermMale)) 12 | reducedDims(sce) <- SimpleList(TSNE=tsneGermMale$Y) 13 | 14 | expect_true(is.null(metadata(sce)$lrbase)) 15 | expect_true(is.null(metadata(sce)$color)) 16 | expect_true(is.null(metadata(sce)$label)) 17 | 18 | # Setting 19 | cellCellSetting(sce, LRBase.Hsa.eg.db, labelGermMale, names(labelGermMale)) 20 | 21 | expect_false(is.null(metadata(sce)$lrbase)) 22 | expect_false(is.null(metadata(sce)$color)) 23 | expect_false(is.null(metadata(sce)$label)) 24 | -------------------------------------------------------------------------------- /tests/testthat/test_labelGermMale.R: -------------------------------------------------------------------------------- 1 | context("labelGermMale") 2 | 3 | data(labelGermMale) 4 | 5 | expect_equivalent(length(labelGermMale), 852) 6 | -------------------------------------------------------------------------------- /tests/testthat/test_tsneGermMale.R: -------------------------------------------------------------------------------- 1 | context("tsneGermMale") 2 | 3 | data(tsneGermMale) 4 | 5 | expect_equivalent(dim(tsneGermMale$Y), c(852, 2)) 6 | -------------------------------------------------------------------------------- /vignettes/Details_115_EA_GO.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_115_EA_GO.jpg -------------------------------------------------------------------------------- /vignettes/Details_115_EA_HEADER.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_115_EA_HEADER.jpg -------------------------------------------------------------------------------- /vignettes/Details_115_HEADER.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_115_HEADER.jpg -------------------------------------------------------------------------------- /vignettes/Details_115_Pair.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_115_Pair.jpg -------------------------------------------------------------------------------- /vignettes/Details_32_EA_HEADER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_32_EA_HEADER.png -------------------------------------------------------------------------------- /vignettes/Details_32_HEADER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_32_HEADER.png -------------------------------------------------------------------------------- /vignettes/Details_32_Pair.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Details_32_Pair.png -------------------------------------------------------------------------------- /vignettes/Ligand_all.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Ligand_all.jpg -------------------------------------------------------------------------------- /vignettes/Ligand_all.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Ligand_all.png -------------------------------------------------------------------------------- /vignettes/Ligand_selected.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Ligand_selected.jpg -------------------------------------------------------------------------------- /vignettes/Ligand_selected.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Ligand_selected.png -------------------------------------------------------------------------------- /vignettes/Mode1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Mode1.jpg -------------------------------------------------------------------------------- /vignettes/Mode2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Mode2.jpg -------------------------------------------------------------------------------- /vignettes/Mode3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Mode3.jpg -------------------------------------------------------------------------------- /vignettes/Mode3Sum.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Mode3Sum.jpg -------------------------------------------------------------------------------- /vignettes/Receptor_all.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_all.jpg -------------------------------------------------------------------------------- /vignettes/Receptor_all.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_all.png -------------------------------------------------------------------------------- /vignettes/Receptor_all_HEADER.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_all_HEADER.jpg -------------------------------------------------------------------------------- /vignettes/Receptor_all_HEADER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_all_HEADER.png -------------------------------------------------------------------------------- /vignettes/Receptor_selected.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_selected.jpg -------------------------------------------------------------------------------- /vignettes/Receptor_selected.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Receptor_selected.png -------------------------------------------------------------------------------- /vignettes/Report.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report.jpeg -------------------------------------------------------------------------------- /vignettes/Report.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report.png -------------------------------------------------------------------------------- /vignettes/Report5_Zoom.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report5_Zoom.jpg -------------------------------------------------------------------------------- /vignettes/Report_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_1.jpg -------------------------------------------------------------------------------- /vignettes/Report_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_1.png -------------------------------------------------------------------------------- /vignettes/Report_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_1.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_2.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_3.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_4.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_4.png -------------------------------------------------------------------------------- /vignettes/Report_2_5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_5.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_6.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_6.jpg -------------------------------------------------------------------------------- /vignettes/Report_2_7.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_2_7.jpg -------------------------------------------------------------------------------- /vignettes/Report_3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_3.jpg -------------------------------------------------------------------------------- /vignettes/Report_4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_4.jpg -------------------------------------------------------------------------------- /vignettes/Report_5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_5.jpg -------------------------------------------------------------------------------- /vignettes/Report_5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_5.png -------------------------------------------------------------------------------- /vignettes/Report_6.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_6.jpg -------------------------------------------------------------------------------- /vignettes/Report_6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_6.png -------------------------------------------------------------------------------- /vignettes/Report_7.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_7.jpg -------------------------------------------------------------------------------- /vignettes/Report_7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_7.png -------------------------------------------------------------------------------- /vignettes/Report_8.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_8.jpg -------------------------------------------------------------------------------- /vignettes/Report_HEADER.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_HEADER.jpg -------------------------------------------------------------------------------- /vignettes/Report_HEADER.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Report_HEADER.png -------------------------------------------------------------------------------- /vignettes/Workflow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Workflow.png -------------------------------------------------------------------------------- /vignettes/Workflow_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rikenbit/scTensor/75d3787e721540c1010cbc150c27ea5a46564d3b/vignettes/Workflow_2.png -------------------------------------------------------------------------------- /vignettes/scTensor.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Detection and visualization of cell-cell interactions using `LRBase` and `scTensor`" 3 | author: 4 | - name: Koki Tsuyuzaki 5 | affiliation: Laboratory for Bioinformatics Research, 6 | RIKEN Center for Biosystems Dynamics Research 7 | - name: Manabu Ishii 8 | affiliation: Laboratory for Bioinformatics Research, 9 | RIKEN Center for Biosystems Dynamics Research 10 | - name: Itoshi Nikaido 11 | affiliation: Laboratory for Bioinformatics Research, 12 | RIKEN Center for Biosystems Dynamics Research 13 | email: k.t.the-answer@hotmail.co.jp 14 | package: scTensor 15 | output: 16 | BiocStyle::html_document 17 | vignette: | 18 | %\VignetteIndexEntry{scTensor} 19 | %\VignetteEngine{knitr::rmarkdown} 20 | %\VignetteEncoding{UTF-8} 21 | --- 22 | 23 | This vignette has been changed in BioC 3.14, when each data package (LRBase.XXX.eg.db) is deprecated and the way to provide LRBase data has changed to AnnotationHub-style. 24 | 25 | # Specification change of `LRBase` and `scTensor` from BioC 3.14 (Nov. 2021) 26 | This section is for the users of previous LRBase.XXX.eg.db-type packages and scTensor. The specifications of the LRBase.XXX.eg.db and scTensor have changed significantly since BioC 3.14. Specifically, the distribution of all LRBase.XXX.eg.db-type packages will be abolished, and the policy has been switched to one where the data is placed on a cloud server called AnnotationHub, and users are allowed to retrieve the data only when they really need it. The following are the advantages of this AnnotationHub-style. 27 | 28 | - The installation time of the entire Bioconductor packages will be reduced. 29 | - Old data will be archived. 30 | - Data reproducibility is ensured (e.g. the version of the data can be specified, such as "v002"). 31 | 32 | # Introduction 33 | ## About Cell-Cell Interaction (CCI) databases 34 | 35 | Due to the rapid development of single-cell RNA-Seq (scRNA-Seq) technologies, wide variety of cell types such as multiple organs of a healthy person, stem cell niche and cancer stem cell have been found. Such complex systems are composed of communication between cells (cell-cell interaction or CCI). 36 | 37 | Many CCI studies are based on the ligand-receptor (L-R)-pair list of FANTOM5 project^[Jordan A. Ramilowski, A draft network of ligand-receptor-mediated multicellular signaling in human, Nature Communications, 2015] as the evidence of CCI (http://fantom.gsc.riken.jp/5/suppl/Ramilowski_et_al_2015/data/PairsLigRec.txt). The project proposed the L-R-candidate genes by following two basises. 38 | 39 | 1. **Subcellular Localization** 40 | 1. Known Annotation (UniProtKB and HPRD) : The term **"Secreted"** for 41 | candidate ligand genes and **"Plasma Membrane"** for 42 | candidate receptor genes 43 | 2. Computational Prediction (LocTree3 and PolyPhobius) 44 | 2. **Physical Binding of Proteins** : Experimentally validated PPI 45 | (protein-protein interaction) information of HPRD and STRING 46 | 47 | The project also merged the data with previous L-R database such as 48 | IUPHAR/DLRP/HPMR and filter out the list without PMIDs. The recent L-R databases such as CellPhoneDB and SingleCellSignalR also manually curated L-R pairs, which are not listed in IUPHAR/DLRP/HPMR. In Bader Laboratory, many putative L-R databases are predicted by their standards. In our framework, we expanded such L-R databases for **134** organisms based on the ortholog relationships. For the details, check the summary of rikenbit/lrbase-workflow^[https://github.com/rikenbit/lrbase-workflow#summary], which is the Snakemake workflow to create LRBase data in each bi-annual update of Bioconductor. 49 | 50 | ## `LRBase` and `scTensor` framework 51 | 52 | Our L-R databases (`LRBase`) are provided a cloud server called AnnotationHub, and users are allowed to retrieve the data only when they really need it. Downloaded data is stored as a cache file on our local machines by the `r Biocpkg("BiocFileCache")` mechanism. Then, the data is converted to LRBase object by `r Biocpkg("LRBaseDbi")`. We also developed `r Biocpkg("scTensor")`, which is a method to detect CCI and the CCI-related L-R pairs simultaneously. This document provides the way to use `r Biocpkg("LRBaseDbi")`, LRBase objects, and `r Biocpkg("scTensor")` (Figure 1). 53 | 54 | ![Figure 1 : Workflow of L-R-related packages](Workflow_2.png) 55 | 56 | # Usage 57 | ## LRBase objects (ligand-receptor database for 134 organisms) 58 | 59 | To create the LRBase of 134 organisms, we introduced 36 approarches including known/putative L-R pairing. 60 | Please see the evidence code of lrbase-workflow^[https://github.com/rikenbit/lrbase-workflow]. 61 | 62 | ### Data retrieval from `AnnotationHub` 63 | 64 | First of all, we download the data of LRBase from AnnotationHub. 65 | `AnnotationHub::AnnotationHub` retrieve the metadata of all the data stored in cloud server. 66 | 67 | ```{r AHub1, echo=TRUE} 68 | library("AnnotationHub") 69 | ah <- AnnotationHub() 70 | mcols(ah) 71 | ``` 72 | 73 | Specifying some keywords in `query()`, we can find LRBase data in AnnotationHub. 74 | 75 | ```{r AHub2, echo=TRUE} 76 | dbfile <- query(ah, c("LRBaseDb", "Homo sapiens", "v002"))[[1]] 77 | ``` 78 | 79 | AnnotationHub also keeps old data as an archive, so please make sure you have the latest version (e.g. "v002" or higher) when you search for LRBaseDb. 80 | 81 | Then, we can convert `dbfile` into LRBase object by using `LRBaseDbi`. 82 | 83 | ```{r AHub3, echo=TRUE} 84 | library("LRBaseDbi") 85 | LRBase.Hsa.eg.db <- LRBaseDbi::LRBaseDb(dbfile) 86 | ``` 87 | 88 | ### columns, keytypes, keys, and select 89 | 90 | Some data access functions are available for LRBase objects. 91 | Any data table are retrieved by 4 functions defined by 92 | `r Biocpkg("AnnotationDbi")`; `columns`, `keytypes`, `keys`, and `select` and commonly implemented by `r Biocpkg("LRBaseDbi")` package. `columns` returns the rows which we can retrieve in LRBase objects. `keytypes` returns the rows which can be used as the optional parameter in `keys` and select functions against LRBase objects. `keys` function returns the value of keytype. `select` function returns the rows in particular columns, which are having user-specified keys. This function returns the result as a dataframe. See the vignette of `r Biocpkg("AnnotationDbi")` for more details. 93 | 94 | ```{r Access, echo=TRUE} 95 | columns(LRBase.Hsa.eg.db) 96 | keytypes(LRBase.Hsa.eg.db) 97 | key_HSA <- keys(LRBase.Hsa.eg.db, keytype="GENEID_L") 98 | head(select(LRBase.Hsa.eg.db, keys=key_HSA[1:2], 99 | columns=c("GENEID_L", "GENEID_R"), keytype="GENEID_L")) 100 | ``` 101 | 102 | ### Other functions 103 | 104 | Other additional functions like `species`, `nomenclature`, and `listDatabases` are available. In each LRBase.XXX.eg.db-type package, `species` function returns the common name and `nomenclature` returns the scientific name. `listDatabases` function returns the source of data. `dbInfo` returns the information of the package. `dbfile` returns the directory where sqlite file is stored. `dbschema` returns the schema of the database. `dbconn` returns the connection to the sqlite database. 105 | 106 | ```{r Other1, echo=TRUE} 107 | lrNomenclature(LRBase.Hsa.eg.db) 108 | species(LRBase.Hsa.eg.db) 109 | lrListDatabases(LRBase.Hsa.eg.db) 110 | lrVersion(LRBase.Hsa.eg.db) 111 | 112 | dbInfo(LRBase.Hsa.eg.db) 113 | dbfile(LRBase.Hsa.eg.db) 114 | dbschema(LRBase.Hsa.eg.db) 115 | dbconn(LRBase.Hsa.eg.db) 116 | ``` 117 | 118 | Combined with `dbGetQuery` function of `r CRANpkg("RSQLite")` package, 119 | more complicated queries also can be submitted. 120 | 121 | ```{r Other2, echo=TRUE} 122 | suppressPackageStartupMessages(library("RSQLite")) 123 | dbGetQuery(dbconn(LRBase.Hsa.eg.db), 124 | "SELECT * FROM DATA WHERE GENEID_L = '9068' AND GENEID_R = '14' LIMIT 10") 125 | ``` 126 | 127 | ## `scTensor` (CCI-tensor construction, decomposition, and HTML reporting) 128 | 129 | Combined with LRBase object and user's gene expression matrix of scRNA-Seq, `r Biocpkg("scTensor")` detects CCIs and generates HTML reports for exploratory data inspection. The algorithm of `r Biocpkg("scTensor")` is as follows. 130 | 131 | Firstly, `r Biocpkg("scTensor")` calculates the celltype-level mean vectors, searches the corresponding pair of genes in the row names of the matrix, and extracted as two vectors. 132 | 133 | Next, the cell type-level mean vectors of ligand expression and that of receptor expression are multiplied as outer product and converted to cell type $\times$ cell type matrix. Here, the multiple matrices can be represented as a three-order "tensor" (Ligand-Cell * Receptor-Cell * L-R-Pair). `r Biocpkg("scTensor")` decomposes the tensor into a small tensor (core tensor) and two factor matrices. Tensor decomposition is very similar to the matrix decomposition like PCA (principal component analysis). The core tensor is similar to the eigenvalue of PCA; this means that how much the pattern is outstanding. Likewise, three matrices are similar to the PC scores/loadings of PCA; These represent which ligand-cell/receptor-cell/L-R-pair are informative. When the matrices have negative values, interpreting which direction (+/-) is important and which is not, is a difficult and laboring task. That's why, `r Biocpkg("scTensor")` 134 | performs non-negative Tucker2 decomposition (NTD2), which is non-negative version of tensor decomposition (cf. `r CRANpkg("nnTensor")`). 135 | 136 | Finally, the result of NTD2 is summarized as an HTML report. Because most of the plots are visualized by `r CRANpkg("plotly")` package, the precise information of the plot can be interactively confirmed by user's on-site web browser. The two factor matrices can be interactively viewed and which cell types and which L-R-pairs are likely to be interacted each other. The mode-3 (LR-pair direction) sum of the core tensor is calculated and visualized as Ligand-Receptor Patterns. Detail of (Ligand-Cell, Receptor-Cell, L-R-pair) Patterns are also visualized. 137 | 138 | ### Creating a `SingleCellExperiment` object 139 | 140 | Here, we use the scRNA-Seq dataset of male germline cells and somatic cells$^{3}$[GSE86146](https://www.ncbi.nlm.nih.gov/geo/query/acc.cgi?acc=GSE86146) as demo data. For saving the package size, the number of genes is strictly reduced by the standard of highly variable genes with a threshold of the p-value are 1E-150 (cf. [Identifying highly variable genes](http://pklab.med.harvard.edu/scw2014/subpop_tutorial.html)). That's why we won't argue about the scientific discussion of the data here. 141 | 142 | We assume that user has a scRNA-Seq data matrix containing expression count data summarised at the level of the gene. First, we create a `r Biocpkg("SingleCellExperiment")` object containing the data. The rows of the object correspond to features, and the columns correspond to cells. The gene identifier is limited as NCBI Gene ID for now. 143 | 144 | To improve the interpretability of the following HTML report, we highly recommend that user specifies the two-dimensional data of input data (e.g. PCA, t-SNE, or UMAP). Such information is easily specified by `reducedDims` function of `r Biocpkg("SingleCellExperiment")` package and is saved to reducedDims slot of `SingleCellExperiment` object (Figure \@ref(fig:cellCellSetting)). 145 | 146 | ```{r SCE1, echo=TRUE} 147 | suppressPackageStartupMessages(library("scTensor")) 148 | suppressPackageStartupMessages(library("SingleCellExperiment")) 149 | ``` 150 | 151 | ```{r SCE2, fig.cap="Germline, Male, GSE86146", echo=TRUE, fig.width=10, fig.height=10} 152 | data(GermMale) 153 | data(labelGermMale) 154 | data(tsneGermMale) 155 | 156 | sce <- SingleCellExperiment(assays=list(counts = GermMale)) 157 | reducedDims(sce) <- SimpleList(TSNE=tsneGermMale$Y) 158 | plot(reducedDims(sce)[[1]], col=labelGermMale, pch=16, cex=2, 159 | xlab="Dim1", ylab="Dim2", main="Germline, Male, GSE86146") 160 | legend("topleft", legend=c(paste0("FGC_", 1:3), paste0("Soma_", 1:4)), 161 | col=c("#9E0142", "#D53E4F", "#F46D43", "#ABDDA4", "#66C2A5", "#3288BD", "#5E4FA2"), 162 | pch=16) 163 | ``` 164 | 165 | ### Parameter setting: `cellCellSetting` 166 | 167 | To perform the tensor decomposition and HTML report, user is supposed to specify 168 | 169 | - 1. LRBaseDb object (e.g. LRBase.Hsa.eg.db) 170 | - 2. cell type vector of each cell (e.g. names(labelGermMale)) 171 | 172 | to `SingleCellExperiment` object. 173 | 174 | ```{r cellCellSetting, echo=TRUE} 175 | cellCellSetting(sce, LRBase.Hsa.eg.db, names(labelGermMale)) 176 | ``` 177 | 178 | The corresponding information is registered to the metadata slot of `SingleCellExperiment` object by `cellCellSetting` function. 179 | 180 | ### CCI-tensor construction and decomposition: `cellCellDecomp` 181 | 182 | After `cellCellSetting`, we can perform tensor decomposition by `cellCellDecomp`. Here the parameter `ranks` is specified as dimension of core tensor. For example, c(2, 3) means The data tensor is decomposed to 2 ligand-patterns and 3 receptor-patterns. 183 | 184 | ```{r cellCellDecomp, echo=TRUE} 185 | set.seed(1234) 186 | cellCellDecomp(sce, ranks=c(2,3)) 187 | ``` 188 | 189 | Although user has to specify the rank to perform cellCellDecomp, we implemented a simple rank estimation function based on the eigenvalues distribution of PCA in the matricised tensor in each mode in `cellCellRank`. `rks$selected` is also specified as rank parameter of `cellCellDecomp`. 190 | 191 | ```{r cellCellRank, echo=TRUE} 192 | (rks <- cellCellRanks(sce)) 193 | rks$selected 194 | ``` 195 | 196 | ### HTML Report: `cellCellReport` 197 | 198 | If `cellCellDecomp` is properly finished, we can perform `cellCellReport` function to output the HTML report like below. Please type `example(cellCellReport)` and the report will be generated in the temporary directory (it costs 5 to 10 minutes). After `cellCellReport`, multiple R markdown files, compiled HTML files, figures, and R binary file containing the result of analysis are saved to `out.dir` (Figure 2). For more details, open the `index.html` by your web browser. Combined with cloud storage service such as Amazon Simple Storage Service (S3), it can be a simple web application and multiple people like collaborators can confirm the same report simultaneously. 199 | 200 | ![Figure2 : cellCellReport function of scTensor](Report.png) 201 | 202 | # Session Information {.unnumbered} 203 | 204 | ```{r sessionInfo, echo=FALSE} 205 | sessionInfo() 206 | ``` -------------------------------------------------------------------------------- /vignettes/scTensor_1_Data_format_ID_Conversion.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Roadmap to prepare the input matrix for `scTensor`" 3 | author: 4 | - name: Koki Tsuyuzaki 5 | affiliation: Laboratory for Bioinformatics Research, 6 | RIKEN Center for Biosystems Dynamics Research 7 | - name: Manabu Ishii 8 | affiliation: Laboratory for Bioinformatics Research, 9 | RIKEN Center for Biosystems Dynamics Research 10 | - name: Itoshi Nikaido 11 | affiliation: Laboratory for Bioinformatics Research, 12 | RIKEN Center for Biosystems Dynamics Research 13 | email: k.t.the-answer@hotmail.co.jp 14 | package: scTensor 15 | output: 16 | BiocStyle::html_document 17 | vignette: | 18 | %\VignetteIndexEntry{scTensor: 1. Data format and ID conversion} 19 | %\VignetteEngine{knitr::rmarkdown} 20 | %\VignetteEncoding{UTF-8} 21 | --- 22 | 23 | This vignette has been changed in BioC 3.14, when each data package (LRBase.XXX.eg.db) is deprecated and the way to provide LRBase data has changed to AnnotationHub-style. 24 | 25 | # Introduction 26 | We explain the way to create a matrix, in which the row names are **NCBI Gene ID (ENTREZID)**, for specifying an input of `r Biocpkg("scTensor")`. 27 | Typical `r Biocpkg("scTensor")` workflow can be described as below. 28 | 29 | ```{r scTensor with NCBI Gene ID, eval=FALSE} 30 | library("scTensor") 31 | library("AnnotationHub") 32 | library("LRBaseDbi") 33 | 34 | # Input matrix 35 | input <- ... 36 | sce <- SingleCellExperiment(assays=list(counts = input)) 37 | # Celltype vector 38 | label <- ... 39 | # LRBase.XXX.eg.db 40 | ah <- AnnotationHub() 41 | dbfile <- query(ah, c("LRBaseDb", "Homo sapiens"))[[1]] 42 | LRBase.Hsa.eg.db <- LRBaseDbi::LRBaseDb(dbfile) 43 | # Setting 44 | cellCellSetting(sce, LRBase.Hsa.eg.db, label) 45 | ``` 46 | 47 | In `r Biocpkg("scTensor")`, the row names of the input matrix is limited only NCBI Gene ID to cooperate with the other R packages (cf. data("Germline")). Since the user has many different types of the data matrix, here we introduce some situations and the way to convert the row names of the user's matrix as NCBI Gene ID. 48 | 49 | # Step.1: Create a gene-level expression matrix 50 | 51 | First of all, we have to prepare the expression matrix (gene $\times$ cell). 52 | There are many types of single-cell RNA-Seq (scRNA-Seq) technologies and the situation will be changed by the used experimental methods and quantification tools described below. 53 | 54 | ## Case I: Gene-level quantification 55 | In Plate-based scRNA-Seq experiment (i.e. Smart-Seq2, Quart-Seq2, CEL-Seq2, MARS-Seq,...etc), the FASTQ file is generated in each cell. After the mapping of reads in each FASTQ file to the reference genome, the same number of BAM files will be generated. 56 | By using some quantification tools such as [featureCounts](http://bioinf.wehi.edu.au/featureCounts/), or [HTSeq-count](https://htseq.readthedocs.io/en/release_0.11.1/count.html), user can get the expression matrix and used as the input of `r Biocpkg("scTensor")`. These tools simply count the number of reads in union-exon in each gene. 57 | One downside of these tools is that such tools do not take "multimap" of not unique reads into consideration and the quantification is not accurate. 58 | Therefore, we recommend the transcript-level quantification and gene-level summarization explained below. 59 | 60 | ## Case II: Transcript-level quantification 61 | Some quantification tools such as [RSEM](https://deweylab.github.io/RSEM/), [Sailfish](https://www.cs.cmu.edu/~ckingsf/software/sailfish/), [Salmon](https://combine-lab.github.io/salmon/), [Kallisto](https://pachterlab.github.io/kallisto/), and [StringTie](http://ccb.jhu.edu/software/stringtie/index.shtml) use the reference transcriptome instead of genome, and quantify the expression level in each transcript. After the quantification, the transcript-level expression can be summarized to gene-level by using `summarizeToGene` function of `r Biocpkg("tximport")`. [The paper of tximport](https://f1000research.com/articles/4-1521) showed that the transcript-level expression summalized to gene-level is more accurate than the gene-level expression calculated by featureCounts. 62 | 63 | Note that if you use the reference transcriptome of [GENCODE](https://www.gencodegenes.org/human/stats.html), this step becomes slightly complicated. Although the number of transcripts of GENCODE and that of [Ensembl](https://ensembl.org/Homo_sapiens/Info/Annotation) is almost the same, 64 | and actually, most of the transcript is duplicated in these two databases, 65 | the gene identifier used in GENCODE looks complicated like "ENST00000456328.2|ENSG00000223972.5|OTTHUMG00000000961.2|OTTHUMT00000362751.1|DDX11L1-202|DDX11L1|1657|processed_transcript|". 66 | In such a case, firstly only Ensembl Transcript ID should be extracted (e.g. ENST00000456328.2), removed the version (e.g. ENST00000456328), summarized to Ensembl Gene ID by tximport (e.g. ENSG00000223972), and then converted to NCBI Gene ID (e.g. 100287102) by each organism package such as `r Biocpkg("Homo.sapiens")`. 67 | 68 | ## Case III: UMI-count 69 | In the droplet-based scRNA-Seq experiment (i.e. Drop-Seq, inDrop RNA-Seq, 10X Chromium), unique molecular identifier (UMI) is introduced for avoiding the bias of PCR amplification, and after multiplexing by cellular barcode, digital gene expression (DGE) matrix is generated by counting the number of types of UMI mapped in each gene. 70 | 71 | When user perform Drop-seq, [Drop-Seq tool](https://github.com/broadinstitute/Drop-seq) can generate the DGE matrix. 72 | 73 | Another tool [Alevin](https://salmon.readthedocs.io/en/latest/alevin.html), which is a subcommand of Salmon is also applicable to Drop-seq data. In such case [tximport] with option "type = 'alevin'" can import the result of Alevin into R and summarize the DGE matrix. 74 | 75 | When the user performs 10X Chromium, using [Cell Ranger](https://support.10xgenomics.com/single-cell-gene-expression/software/pipelines/latest/what-is-cell-ranger) developed by 10X Genomics is straightforward. 76 | 77 | Although Cell Ranger is implemented by Python, starting from the files generated by Cell Ranger (e.g. filtered_gene_bc_matrices/{hg19,mm10}/{barcodes.tsv,genes.tsv,matrix.mtx}), `r CRANpkg("Seurat")` can import these files to an R object. 78 | 79 | For example, according to the tutorial of Seurat ([Seurat - Guided Clustering Tutorial](https://satijalab.org/seurat/v3.0/pbmc3k_tutorial.html)), PBMC data of Cell Ranger can be imported by the `Read10X` function and DGE matrix of UMI-count is available by the output of `CreateSeuratObject` function. 80 | 81 | ```{r Seurat, eval=FALSE} 82 | if(!require(Seurat)){ 83 | BiocManager::install("Seurat") 84 | library(Seurat) 85 | } 86 | 87 | # Load the PBMC dataset 88 | pbmc.data <- Read10X(data.dir = "filtered_gene_bc_matrices/hg19/") 89 | 90 | # Initialize the Seurat object with the raw (non-normalized data). 91 | pbmc <- CreateSeuratObject(counts = pbmc.data, 92 | project = "pbmc3k", min.cells = 3, min.features = 200) 93 | ``` 94 | 95 | **Note that the matrix is formatted as a sparse matrix of `r CRANpkg("Matrix")` package (MM: Matrix market), but the `r Biocpkg("scTensor")` assumes dense matrix for now.** 96 | By using `as.matrix` function, 97 | the sparse matrix is easily converted to a dense matrix as follows. 98 | 99 | ``` 100 | # Sparse matrix to dense matrix 101 | for_sc <- as.matrix(pbmc.data) 102 | ``` 103 | 104 | # Step.2: Convert the row names of a matrix as NCBI Gene ID (ENTREZID) 105 | 106 | Even after creating the gene-level expression matrix in Step.1, 107 | many kinds of gene-level gene identifiers can be assigned as row names of the matrix such as Ensembl Gene ID, RefSeq, or Gene Symbol. 108 | Again, only NCBI Gene ID can be used as row names of the input matrix of `r Biocpkg("scTensor")`. 109 | To do such a task, we originally implemented a function `convertRowID` function of `r Biocpkg("scTGIF")`. 110 | The only user has to prepare for using this function is the 1. input matrix (or data.frame) filled with only numbers, 2. current gene-level gene identifier in each row of the input matrix, and 3. corresponding table containing current gene-level gene identifier (left) and corresponding NCBI Gene ID (right). 111 | The usage of this function is explained below. 112 | 113 | ## Case I: Ensembl Gene ID to NCBI Gene ID 114 | In addition to 1. and 2., the user has to prepare the 3. corresponding table. 115 | Here we introduce two approaches to assign the user's Ensembl Gene ID to NCBI Gene ID. 116 | First approarch is using [Organism DB](https://bioconductor.org/packages/release/BiocViews.html#___OrganismDb) packages such as `r Biocpkg("Homo.sapiens")`, `r Biocpkg("Mus.musculus")`, and `r Biocpkg("Rattus.norvegicus")`. 117 | 118 | Using the `select` function of Organism DB, the corresponding table can be retrieved like below. 119 | 120 | ```{r Ensembl with Organism DB, echo=TRUE} 121 | suppressPackageStartupMessages(library("scTensor")) 122 | if(!require(Homo.sapiens)){ 123 | BiocManager::install("Homo.sapiens") 124 | suppressPackageStartupMessages(library(Homo.sapiens)) 125 | } 126 | if(!require(scTGIF)){ 127 | BiocManager::install("scTGIF") 128 | suppressPackageStartupMessages(library(scTGIF)) 129 | } 130 | 131 | # 1. Input matrix 132 | input <- matrix(1:20, nrow=4, ncol=5) 133 | # 2. Gene identifier in each row 134 | rowID <- c("ENSG00000204531", "ENSG00000181449", 135 | "ENSG00000136997", "ENSG00000136826") 136 | # 3. Corresponding table 137 | LefttoRight <- select(Homo.sapiens, 138 | column=c("ENSEMBL", "ENTREZID"), 139 | keytype="ENSEMBL", keys=rowID) 140 | # ID conversion 141 | (input <- convertRowID(input, rowID, LefttoRight)) 142 | ``` 143 | 144 | Second approarch is using `r Biocpkg("AnnotationHub")` package. 145 | 146 | Although only three Organism DB packages are explicitly developed, 147 | even if the data is generated from other species (e.g. Zebrafish, Arabidopsis thaliana), 148 | similar database is also available from `r Biocpkg("AnnotationHub")`, 149 | and `select` function can be performed like below. 150 | 151 | ```{r Ensembl with AnnotationHub, echo=TRUE} 152 | suppressPackageStartupMessages(library("AnnotationHub")) 153 | 154 | # 1. Input matrix 155 | input <- matrix(1:20, nrow=4, ncol=5) 156 | # 3. Corresponding table 157 | ah <- AnnotationHub() 158 | # Database of Human 159 | hs <- query(ah, c("OrgDb", "Homo sapiens"))[[1]] 160 | LefttoRight <- select(hs, 161 | column=c("ENSEMBL", "ENTREZID"), 162 | keytype="ENSEMBL", keys=rowID) 163 | (input <- convertRowID(input, rowID, LefttoRight)) 164 | ``` 165 | 166 | ## Case II: Gene Symbol to NCBI Gene ID 167 | When using cellranger or `r CRANpkg("Seurat")` to quantify UMI-count (cf. Step1, Case III), 168 | the row names of the input matrix might be Gene Symbol, 169 | and have to be converted to NCBI Gene ID. 170 | As well as the Case I described above, 171 | [Organism DB](https://bioconductor.org/packages/release/BiocViews.html#___OrganismDb) 172 | and `r Biocpkg("AnnotationHub")` will support such a task like below. 173 | 174 | ```{r Gene Symbol with Organism DB, echo=TRUE} 175 | # 1. Input matrix 176 | input <- matrix(1:20, nrow=4, ncol=5) 177 | # 2. Gene identifier in each row 178 | rowID <- c("POU5F1", "SOX2", "MYC", "KLF4") 179 | # 3. Corresponding table 180 | LefttoRight <- select(Homo.sapiens, 181 | column=c("SYMBOL", "ENTREZID"), 182 | keytype="SYMBOL", keys=rowID) 183 | # ID conversion 184 | (input <- convertRowID(input, rowID, LefttoRight)) 185 | ``` 186 | 187 | ```{r Gene Symbol with AnnotationHub, echo=TRUE} 188 | # 1. Input matrix 189 | input <- matrix(1:20, nrow=4, ncol=5) 190 | # 3. Corresponding table 191 | ah <- AnnotationHub() 192 | # Database of Human 193 | hs <- query(ah, c("OrgDb", "Homo sapiens"))[[1]] 194 | LefttoRight <- select(hs, 195 | column=c("SYMBOL", "ENTREZID"), 196 | keytype="SYMBOL", keys=rowID) 197 | (input <- convertRowID(input, rowID, LefttoRight)) 198 | ``` 199 | 200 | # Step.3: Normalize the count matrix 201 | 202 | Finally, we introduce some situations to perform some normalization methods of gene expression matrix. 203 | 204 | If a user converts a Seurat object to a SingleCellExperient object by using `as.SingleCellExperiment`, 205 | the result of the `NormalizeData` function (log counts) is inherited to the SingleCellExperient object as follows; 206 | 207 | ```{r Seurat normalization, eval=FALSE} 208 | pbmc2 <- NormalizeData(pbmc, normalization.method = "LogNormalize", 209 | scale.factor = 10000) 210 | sce <- as.SingleCellExperiment(pbmc2) 211 | assayNames(sce) # counts, logcounts 212 | ``` 213 | 214 | If the user want to use `r Biocpkg("scater")` package, 215 | `calculateCPM` or `normalize` function can calculate the normalized expression values as follows; (see also [the vignette of scater](https://bioconductor.org/packages/release/bioc/vignettes/scater/inst/doc/vignette-intro.html)). 216 | 217 | ```{r Scater normalization, eval=FALSE} 218 | if(!require(scater)){ 219 | BiocManager::install("scater") 220 | library(scater) 221 | } 222 | sce <- SingleCellExperiment(assays=list(counts = input)) 223 | cpm(sce) <- calculateCPM(sce) 224 | sce <- normalize(sce) 225 | assayNames(sce) # counts, normcounts, logcounts, cpm 226 | ``` 227 | 228 | Any original normalization can be stored in the sce. 229 | For example, we can calculate the value of count per median (CPMED) as follows; 230 | 231 | ```{r Original normalization, eval=FALSE} 232 | # User's Original Normalization Function 233 | CPMED <- function(input){ 234 | libsize <- colSums(input) 235 | median(libsize) * t(t(input) / libsize) 236 | } 237 | # Normalization 238 | normcounts(sce) <- log10(CPMED(counts(sce)) + 1) 239 | ``` 240 | 241 | We recommend using the normcounts slot to save such original normalization values. 242 | After the normalization, such values can be specified by `assayNames` option in `cellCellRanks` `cellCellDecomp` and `cellCellReport` functions. 243 | 244 | # Session information {.unnumbered} 245 | 246 | ```{r sessionInfo, echo=FALSE} 247 | sessionInfo() 248 | ``` 249 | -------------------------------------------------------------------------------- /vignettes/scTensor_2_Report_Interpretation.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How to interpret the HTML report generated by `cellCellReport` function" 3 | author: 4 | - name: Koki Tsuyuzaki 5 | affiliation: Laboratory for Bioinformatics Research, 6 | RIKEN Center for Biosystems Dynamics Research 7 | - name: Manabu Ishii 8 | affiliation: Laboratory for Bioinformatics Research, 9 | RIKEN Center for Biosystems Dynamics Research 10 | - name: Itoshi Nikaido 11 | affiliation: Laboratory for Bioinformatics Research, 12 | RIKEN Center for Biosystems Dynamics Research 13 | email: k.t.the-answer@hotmail.co.jp 14 | package: scTensor 15 | output: 16 | BiocStyle::html_document 17 | vignette: | 18 | %\VignetteIndexEntry{scTensor: 2. Interpretation of HTML report} 19 | %\VignetteEngine{knitr::rmarkdown} 20 | %\VignetteEncoding{UTF-8} 21 | --- 22 | 23 | # Introduction 24 | 25 | Here, we explain the way to interpret of HTML report generated by `cellCellReport`. 26 | If `cellCellDecomp` is properly finished, we can perform `cellCellReport` 27 | function to output the HTML report. 28 | The results can be confirmed by typing `example(cellCellReport)`. 29 | The report will be generated in the temporary directory (it costs 5 to 10 minutes). 30 | The output directory contains some files and directories as follows. 31 | 32 | - **index.{Rmd,html}** : The main HTML report 33 | - **reanalysis.RData** : The R binary file for using in the HTML report and reanalysis of scTensor 34 | - **Workflow_2.png** : The figure for the section 1. About scTensor Algorithm in the HTML report 35 | - **figures** : The directory containing some figures for the HTML report 36 | - **ligand.{Rmd,html}** : The HTML report for the section 6. Gene-wise Hypergraph in the HTML report 37 | - **ligand_all.{Rmd,html}** : The HTML report for the section 6. Gene-wise Hypergraph in the HTML report 38 | - **receptor.{Rmd,html}** : The HTML report for the section 6. Gene-wise Hypergraph in the HTML report 39 | - **receptor_all.{Rmd,html}** : The HTML report for the section 6. Gene-wise Hypergraph in the HTML report 40 | - **pattern_X_Y.{Rmd,html}** : The HTML report for For the section 7. (Ligand-Cell, Receptor-Cell, ) -related L-R Pairs in the HTML report 41 | 42 | Here, look at the index.html. 43 | 44 | ![Figure1 : HTML report of `cellCellReport`](Report_HEADER.png) 45 | 46 | # Interpretation of "1. About scTensor Algorithm" 47 | 48 | In the HTML report, the 1st item describes the overview of `r Biocpkg("scTensor")` and other CCI-related packages. 49 | 50 | ![Figure2: 1. About scTensor Algorithm](Report_1.png) 51 | 52 | # Interpretation of "2. Global statistics and plots" 53 | 54 | The 2nd item describes all the R objects saved in **reanalysis.RData**, 55 | which contains the result of `r Biocpkg("scTensor")`. 56 | This file is saved in the output directory (**out.dir**) specified in `cellCellReport`, 57 | and the user also can re-analyze the result of `r Biocpkg("scTensor")`. 58 | 59 | ![Figure3: 2. Global statistics and plots](Report_2.jpg) 60 | 61 | Using `r CRANpkg("plotly")` package, `cellCellReport` generates some interactive plots. 62 | For example, in item 2.1, the number of cells in each cell type can be confirmed when the cursor moved on the box. 63 | 64 | ![Figure4: 2.1 Number of cells in each celltype](Report_2_1.jpg) 65 | 66 | In item 2.2, the number of expressed genes in each cell type (Non-zero genes) can be confirmed when the cursor moved on the box. 67 | ![Figure5: 2.2 Number of expressed genes in each cell type (Non-zero genes)](Report_2_2.jpg) 68 | 69 | In item 2.3, the two-dimensional plot user specified can be confirmed. 70 | ![Figure6: 2.3 Two dimensional plot of all cells](Report_2_3.jpg) 71 | 72 | In item 2.4, the distribution of core tensor values and the value of each (Ligand-Cell-type, Receptor-Cell-type, LR-pair) pattern can be confirmed. 73 | 74 | The red bars mean that these values are selected by the threshold (**thr** parameters) in `cellCellReport`. 75 | 76 | Note that the thr can be specified from 0 to 100, 77 | the large thr value will generate too many HTML files (cf. 8. (Ligand-Cell, Receptor-Cell, LR-pair) Patterns) 78 | and takes a long time. 79 | 80 | ![Figure7 : 2.4 Distribution of core tensor values](Report_2_4.png) 81 | 82 | The 3-order CCI-tensor consisting of Cell_L $\times$ Cell_R $\times$ LR-pair (LR) are decomposed by `r CRANpkg("nnTensor")`, 83 | in which the tensor is iteratively matricised to mode-1 (Ligand-Cell direction) and mode-2 (Receptor-Cell direction). 84 | 85 | In each direction, NMF is performed and the strength of each directional pattern is summarized in the bar plots. 86 | 87 | For example, in item 2.5, the distribution of mode-1 matricised tensor can be confirmed. 88 | 89 | ![Figure8: 2.5 Distribution of mode-1 matricised tensor (Ligand-Cell Direction) (1/2)](Mode1.jpg) 90 | 91 | ![Figure9: 2.5 Distribution of mode-1 matricised tensor (Ligand-Cell Direction) (2/2)](Report_2_5.jpg) 92 | 93 | Likewise, in item 2.6, the distribution of mode-2 matricised tensor can be confirmed, 94 | 95 | ![Figure10 : 2.6 Distribution of mode-2 matricised tensor (Receptor-Cell Direction) (1/2)](Mode2.jpg) 96 | 97 | ![Figure11 : 2.6 Distribution of mode-2 matricised tensor (Receptor-Cell Direction) (2/2)](Report_2_6.jpg) 98 | 99 | # Interpretation of "3. Ligand-Cell Patterns" 100 | 101 | In the 3rd item, using the heatmap of `r CRANpkg("plotly")`, the user can interactively confirm the detail of Ligand-Cell Patterns extracted by `r CRANpkg("nnTensor")`. 102 | 103 | ![Figure14 : 3. Ligand-Cell Patterns](Report_3.jpg) 104 | 105 | # Interpretation of "4. Receptor-Cell Patterns" 106 | 107 | Likewise, in the 4th item, the user can interactively confirm the detail of Receptor-Cell Patterns. 108 | 109 | ![Figure15 : 4. Receptor-Cell Patterns](Report_4.jpg) 110 | 111 | # Interpretation of "5. CCI-wise Hypergraph" 112 | 113 | In the 6th item describes, the strength between Ligand-Cell Patterns and Receptor-Cell Patterns (CCI-strength), 114 | by the summation of the core tensor with the mode-3 direction, 115 | a matrix consisting of the number of Ligand-Cell Patterns $\times$ the number of Receptor-Cell Patterns. 116 | 117 | ![Figure18 : 6. CCI-wise Hypergraph (1/2)](Mode3Sum.jpg) 118 | ![Figure19 : 6. CCI-wise Hypergraph (2/2)](Report_5.png) 119 | 120 | # Interpretation of "6. Gene-wise Hypergraph" 121 | 122 | In the 7th item, the relationship between LR-pairs, which coexpressed in any LR-pair pattern at least one time. 123 | Ligand genes are described as red nodes, 124 | receptor genes are described as blue nodes, 125 | and corresponding LR-pair patterns are described as the color of edges. 126 | Using `r CRANpkg("visNetwork")` package, 127 | these interactions can be interactively visualized. 128 | 129 | ![Figure20 : 7. Gene-wise Hypergraph](Report_6.png) 130 | 131 | Under the gene-wise hypergraph, four hyperlinks are embedded. 132 | 133 | In the 1st link, the details of the gene-wise hypergraph can be confirmed as a corresponding table in a ligand gene-centric manner. 134 | This page can work as a reverse lookup search by "Ctrl + F"; 135 | by typing the gene name of ligand that the user is interested in, 136 | the partner receptors, which are coexpressed in some LR-pair patterns, 137 | also can be found. 138 | ![Figure21: Details of Ligand Gene-centric Overview (selected)](Ligand_selected.png) 139 | 140 | 141 | In the 2nd link, the user can find all the partner receptors, 142 | even if the partner receptors are not coexpressed in any LR-pair pattern, 143 | and if they are not included in the data matrix. 144 | ![Figure22: Details of Ligand Gene-centric Overview (all)](Ligand_all.png) 145 | 146 | Likewise, the receptor gene-centric reverse search page is embedded in the 3rd link, 147 | ![Figure23: Details of Receptor Gene-centric Overview (selected)](Receptor_selected.png) 148 | 149 | and, in the 4th link, all the partner ligand genes are included. 150 | ![Figure24: Details of Receptor Gene-centric Overview (all) (1/2)](Receptor_all_HEADER.png) 151 | ![Figure25 : Details of Receptor Gene-centric Overview (all) (2/2)](Receptor_all.png) 152 | 153 | # Interpretation of "7. (Ligand-Cell, Receptor-Cell, LR-pair) Patterns" 154 | 155 | In the 8th item, the details of (Ligand-Cell, Receptor-Cell, LR-pair) Patterns are ordered by the size of the core tensor, and the link of each pattern is embedded. 156 | 157 | (Note that the number of links is dependent on the **thr** parameter of `cellCellReport`.) 158 | ![Figure26: 8. (Ligand-Cell, Receptor-Cell, LR-pair) Patterns](Report_7.png) 159 | 160 | For example, the 1st link describes the details of (3,2,) Pattern, which means the relationship of *1*st pattern of Ligand-Cell patterns, *1*st pattern of Receptor-Cell patterns, and *5*th pattern of LR-pair patterns. 161 | ![Figure27 : Details of (3,2,) Pattern (1/3)](Details_32_HEADER.png) 162 | 163 | In this pattern, only one LR-pair is coexpressed (INSL3 and GNG11). 164 | The hyperlinks to many databases and PubMed are also embedded. 165 | The degree of the size of the LR-pair in the LR-pair pattern is quantified as P-value and Q-value. 166 | ![Figure28 : Details of (3,2,) Pattern (2/3)](Details_32_Pair.png) 167 | 168 | Under the LR-pair list, 169 | the results of many enrichment analysis are also embedded such as Gene Ontology (BP/MF/CC), Reactome, MeSH...etc. 170 | ![Figure29 : Details of (3,2,) Pattern (3/3)](Details_32_EA_HEADER.png) 171 | 172 | User can confirm the detail of the result of `r Biocpkg("scTensor")`, and perform the biological interpretation. 173 | 174 | # Session information {.unnumbered} 175 | 176 | ```{r sessionInfo, echo=FALSE} 177 | sessionInfo() 178 | ``` 179 | -------------------------------------------------------------------------------- /vignettes/scTensor_3_CCI_Simulation.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How to perform CCI simulation by `cellCellSimulate` function" 3 | author: 4 | - name: Koki Tsuyuzaki 5 | affiliation: Laboratory for Bioinformatics Research, 6 | RIKEN Center for Biosystems Dynamics Research 7 | - name: Manabu Ishii 8 | affiliation: Laboratory for Bioinformatics Research, 9 | RIKEN Center for Biosystems Dynamics Research 10 | - name: Itoshi Nikaido 11 | affiliation: Laboratory for Bioinformatics Research, 12 | RIKEN Center for Biosystems Dynamics Research 13 | email: k.t.the-answer@hotmail.co.jp 14 | package: scTensor 15 | output: 16 | BiocStyle::html_document 17 | vignette: | 18 | %\VignetteIndexEntry{scTensor: 3. Simulation of CCI} 19 | %\VignetteEngine{knitr::rmarkdown} 20 | %\VignetteEncoding{UTF-8} 21 | --- 22 | 23 | # Introduction 24 | 25 | Here, we explain the way to generate CCI simulation data. 26 | `r Biocpkg("scTensor")` has a function `cellCellSimulate` 27 | to generate the simulation data. 28 | 29 | The simplest way to generate such data is `cellCellSimulate` with default parameters. 30 | 31 | ```{r cellCellSimulate_Default, echo=TRUE} 32 | suppressPackageStartupMessages(library("scTensor")) 33 | sim <- cellCellSimulate() 34 | ``` 35 | 36 | This function internally generate the parameter sets by `newCCSParams`, 37 | and the values of the parameter can be changed, and specified as the input of `cellCellSimulate` by users as follows. 38 | 39 | ```{r cellCellSimulate_Setting, echo=TRUE} 40 | # Default parameters 41 | params <- newCCSParams() 42 | str(params) 43 | 44 | # Setting different parameters 45 | # No. of genes : 1000 46 | setParam(params, "nGene") <- 1000 47 | # 3 cell types, 20 cells in each cell type 48 | setParam(params, "nCell") <- c(20, 20, 20) 49 | # Setting for Ligand-Receptor pair list 50 | setParam(params, "cciInfo") <- list( 51 | nPair=500, # Total number of L-R pairs 52 | # 1st CCI 53 | CCI1=list( 54 | LPattern=c(1,0,0), # Only 1st cell type has this pattern 55 | RPattern=c(0,1,0), # Only 2nd cell type has this pattern 56 | nGene=50, # 50 pairs are generated as CCI1 57 | fc="E10"), # Degree of differential expression (Fold Change) 58 | # 2nd CCI 59 | CCI2=list( 60 | LPattern=c(0,1,0), 61 | RPattern=c(0,0,1), 62 | nGene=30, 63 | fc="E100") 64 | ) 65 | # Degree of Dropout 66 | setParam(params, "lambda") <- 10 67 | # Random number seed 68 | setParam(params, "seed") <- 123 69 | 70 | # Simulation data 71 | sim <- cellCellSimulate(params) 72 | ``` 73 | 74 | The output object **sim** has some attributes as follows. 75 | 76 | Firstly, **sim$input** contains a synthetic gene expression matrix. 77 | The size can be changed by **nGene** and **nCell** parameters described above. 78 | 79 | ```{r input, echo=TRUE} 80 | dim(sim$input) 81 | sim$input[1:2,1:3] 82 | ``` 83 | 84 | Next, **sim$LR** contains a ligand-receptor (L-R) pair list. 85 | The size can be changed by **nPair** parameter of **cciInfo**, 86 | and the differentially expressed (DE) L-R pairs 87 | are saved in the upper side of this matrix. 88 | Here, two DE L-R patterns are specified as **cciInfo**, 89 | and each number of pairs is 50 and 30, respectively. 90 | 91 | ```{r LR, echo=TRUE} 92 | dim(sim$LR) 93 | sim$LR[1:10,] 94 | sim$LR[46:55,] 95 | sim$LR[491:500,] 96 | ``` 97 | 98 | Finally, **sim$celltypes** contains a cell type vector. 99 | Since **nCell** is specified as "c(20, 20, 20)" described above, 100 | three cell types are generated. 101 | 102 | ```{r celltypes, echo=TRUE} 103 | length(sim$celltypes) 104 | head(sim$celltypes) 105 | table(names(sim$celltypes)) 106 | ``` 107 | 108 | # Session information {.unnumbered} 109 | 110 | ```{r sessionInfo, echo=FALSE} 111 | sessionInfo() 112 | ``` 113 | -------------------------------------------------------------------------------- /vignettes/scTensor_4_Reanalysis.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "How to reanalyze the results of scTensor" 3 | author: 4 | - name: Koki Tsuyuzaki 5 | affiliation: Laboratory for Bioinformatics Research, 6 | RIKEN Center for Biosystems Dynamics Research 7 | - name: Manabu Ishii 8 | affiliation: Laboratory for Bioinformatics Research, 9 | RIKEN Center for Biosystems Dynamics Research 10 | - name: Itoshi Nikaido 11 | affiliation: Laboratory for Bioinformatics Research, 12 | RIKEN Center for Biosystems Dynamics Research 13 | email: k.t.the-answer@hotmail.co.jp 14 | package: scTensor 15 | output: 16 | BiocStyle::html_document 17 | vignette: | 18 | %\VignetteIndexEntry{scTensor: 4. Reanalysis of the results of scTensor} 19 | %\VignetteEngine{knitr::rmarkdown} 20 | %\VignetteEncoding{UTF-8} 21 | --- 22 | 23 | # Summary of the output objects of scTensor 24 | 25 | Here, we introduced the objects saved in reanalysis.RData. 26 | 27 | ```{r reanalysis.RData, eval=FALSE} 28 | library("scTensor") 29 | load("reanalysis.RData") 30 | ``` 31 | 32 | After performing `cellCellReport`, some R objects are saved in the reanalysis.RData as follows; 33 | 34 | - **sce** : SingleCellExperiment object 35 | - **metadata(sce)$lrbase** : The file pass to the database file of LRBase 36 | - **metadata(sce)$color** : The color vector specified by `cellCellSetting` 37 | - **metadata(sce)$label** : The label vector specified by `cellCellSetting` 38 | - **metadata(sce)$algorithm** : The algorithm for performing `r Biocpkg("scTensor")` 39 | - **metadata(sce)$sctensor** : The results of `r Biocpkg("scTensor")` 40 | - **metadata(sce)\$sctensor\$ligand** : The factor matrix (Ligand) 41 | - **metadata(sce)\$sctensor\$receptor** : The factor matrix (Receptor) 42 | - **metadata(sce)\$sctensor\$lrpair** : The core tensor 43 | - **metadata(sce)$datasize** : The data size of CCI tensor 44 | - **metadata(sce)$ranks** : The number of lower dimension in each direction of CCI tensor 45 | - **metadata(sce)$recerror** : Reconstruction Error of NTD 46 | - **metadata(sce)$relchange** : Relative Change of NTD 47 | - **input** : The gene expression matrix <# Genes * # Cells> 48 | - **twoD** : The result of 2D dimensional reduction (e.g. t-SNE) 49 | - **LR** : The Ligand-Receptor corresponding table extracted from LRBase.XXX.eg.db 50 | - **celltypes** : The celltype label and color scheme 51 | - **index** : The core tensor values 52 | - **corevalue** : The core tensor values (normalized) 53 | - **selected** : The selected corevalue position with thr threshold "thr" 54 | - **ClusterL** : The result of analysis in each L vector 55 | - **ClusterR** : The result of analysis in each R vector 56 | - **out.vecLR** : The result of analysis in LR pairs 57 | - **g** : The igraph object to visualize ligand-receptor gene network 58 | 59 | # Execution of scTensor with the different options 60 | 61 | Using the `reanalysis.RData`, some users may want to perform `r Biocpkg("scTensor")` with different parameters. 62 | 63 | For example, some users want to perform `cellCellDecomp` with different ranks, perform `cellCellReport` with omitting some enrichment analysis, provide the results to their collaborators. 64 | 65 | To do such tasks, just type like belows. 66 | 67 | ```{r Reanalysis, eval=FALSE} 68 | library("AnnotationHub") 69 | library("LRBaseDbi") 70 | 71 | # Create LRBase object 72 | ah <- AnnotationHub() 73 | dbfile <- query(ah, c("LRBaseDb", "Homo sapiens"))[[1]] 74 | LRBase.Hsa.eg.db <- LRBaseDbi::LRBaseDb(dbfile) 75 | 76 | # Register the file pass of user's LRBase 77 | metadata(sce)$lrbase <- dbfile(LRBase.Hsa.eg.db) 78 | 79 | # CCI Tensor Decomposition 80 | cellCellDecomp(sce, ranks=c(6,5), assayNames="normcounts") 81 | 82 | # HTML Report 83 | cellCellReport(sce, reducedDimNames="TSNE", assayNames="normcounts", 84 | title="Cell-cell interaction within Germline_Male, GSE86146", 85 | author="Koki Tsuyuzaki", html.open=TRUE, 86 | goenrich=TRUE, meshenrich=FALSE, reactomeenrich=FALSE, 87 | doenrich=FALSE, ncgenrich=FALSE, dgnenrich=FALSE) 88 | ``` 89 | 90 | # Session information {.unnumbered} 91 | 92 | ```{r sessionInfo, echo=FALSE} 93 | sessionInfo() 94 | ``` 95 | --------------------------------------------------------------------------------