Skip to content

Commit

Permalink
updating
Browse files Browse the repository at this point in the history
  • Loading branch information
jsnagai committed Oct 29, 2021
1 parent 7cf4b04 commit 1054f8d
Show file tree
Hide file tree
Showing 4 changed files with 61 additions and 127 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: CrossTalkeR
Title: Single Cell Ligand Receptor Downstream analysis
Version: 1.3.0
Version: 1.3.1
Authors@R:c(
person(given = "James Shiniti",
family = "Nagai",
Expand Down
28 changes: 6 additions & 22 deletions inst/templates/Comparative_Condition_cci.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ output:
params:
obj1: "path to obj"
thr: 'percentage edges to plot'
sel: 'selected columns'

---

Expand Down Expand Up @@ -38,7 +37,7 @@ extrafont::loadfonts()

### Interaction Plot (CCI)

*Here, the cell-cell interaction is provided for each phenotype comparison between phenotypes*
*Here, the cell-cell interaction is provided for each phenotype comparison between phenotypes. Note that this is a FILTERED data*

```{r fig.align='center', fig.height=8,fig.width=8,message=FALSE, warning=FALSE, echo=FALSE,fig.keep = 'all'}
path <-params$obj1
Expand All @@ -47,9 +46,11 @@ all_data <- readRDS(path)
for(i in 1:length(names(all_data@tables))){
curr <- names(all_data@tables)[i]
if(str_detect(curr, '_x_', negate = FALSE) & !str_detect(curr, 'ggi', negate = FALSE)){
message(paste0('Printing CCI ',curr))
curr_net <- all_data@graphs[[curr]]
low <- thr
h <- head_of(data@graphs[[curr]],E(data@graphs[[curr]]))$name
f <- tail_of(data@graphs[[curr]],E(data@graphs[[curr]]))$name
curr_net <- subgraph.edges(all_data@graphs[[curr]],E(data@graphs[[curr]])[match(data@stats[[curr]]$columns_name[data@stats[[curr]]$p<=0.05]
,paste(h,f,sep = '_'))])
low <- thr
par(cex.axis=7, cex.lab=7)
plot_cci(graph=curr_net,
coords=all_data@coords[V(curr_net)$name,],
Expand Down Expand Up @@ -118,23 +119,6 @@ for(i in 2:length(names(all_data@rankings))){
}
```

### Fisher Test CCI


```{r fig.align='center',warning=FALSE,echo=FALSE,fig.keep='all',fig.width=10,fig.height=10}
for(i in names(all_data@stats)){
sel <- all_data@stats[[i]][all_data@stats[[i]]$p <= 0.05,]
print(ggplot(sel,aes(x=lodds,y=reorder(columns_name,lodds),fill=ifelse(lodds>0,T,F)))+
geom_bar(stat='identity')+
geom_text(aes(label=round(p,4), vjust=-0.3, size=3.5,hjust=0.3))+
scale_fill_manual(values = c(Blue2DarkOrange18Steps[4],Blue2DarkOrange18Steps[14]))+
xlab("Log Odds Ratio")+
ylab("Cell Cell Interactions")+
ggtitle('Fisher test: EXP vs CTR')+
theme_minimal())
}
```


### CCI Table

Expand Down
75 changes: 47 additions & 28 deletions inst/templates/Comparative_Condition_cgi.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@ output:
params:
obj1: "path to obj"
thr: 'percentage edges to plot'
sel: 'selected columns'

---

Expand Down Expand Up @@ -48,25 +47,25 @@ all_data <- readRDS(path)
for(i in 1:length(names(all_data@pca))){
curr <- names(all_data@pca)[i]
if(str_detect(curr, '_x_', negate = FALSE) & str_detect(curr, '_ggi', negate = FALSE)){
rmd_title <- paste0(curr,'_tbl')
rmd_title1 <- paste0(curr,'_pca')
x <- max(abs(all_data@pca[[curr]]$x[,1]))
y <- max(abs(all_data@pca[[curr]]$x[,2]))
z_x <- all_data@pca[[curr]]$x[,1]
z_y <- all_data@pca[[curr]]$x[,2]
ver_zx <- ifelse(abs(z_x)>=(2*all_data@pca[[curr]]$sdev[1]),1,0)
ver_zy <- ifelse(abs(z_y)>=(2*all_data@pca[[curr]]$sdev[2]),1,0)
print(fviz_pca_biplot(all_data@pca[[curr]],
axes = c(1,2),
pointshape = 21, pointsize = 0.5,labelsize = 10,
repel = FALSE,max.overlaps=100,label='var')+
geom_label_repel(aes(label=ifelse((ver_zx | ver_zy),rownames(all_data@pca[[curr]]$x),NA)),size = 5)+
xlim(-x, x)+
ylim(-y, y)+
ggtitle(curr)+
theme(text = element_text(size = 7.5),
axis.title = element_text(size = 7.5),
axis.text = element_text(size = 7.5)))
rmd_title <- paste0(curr,'_tbl')
rmd_title1 <- paste0(curr,'_pca')
x <- max(abs(all_data@pca[[curr]]$x[,1]))
y <- max(abs(all_data@pca[[curr]]$x[,2]))
z_x <- data@pca[[curr]]$x[,1]
z_y <- data@pca[[curr]]$x[,2]
ver_zx <- ifelse(abs(z_x)>=(2*data@pca[[curr]]$sdev[1]),1,0)
ver_zy <- ifelse(abs(z_y)>=(2*data@pca[[curr]]$sdev[2]),1,0)
print(fviz_pca_biplot(data@pca[[curr]],
axes = c(1,2),
pointshape = 21, pointsize = 0.5,labelsize = 10,
repel = FALSE,max.overlaps=100,label='var')+
geom_label_repel(aes(label=ifelse((ver_zx | ver_zy),rownames(data@pca[[curr]]$x),NA)),size = 5)+
xlim(-x, x)+
ylim(-y, y)+
ggtitle(curr)+
theme(text = element_text(size = 7.5),
axis.title = element_text(size = 7.5),
axis.text = element_text(size = 7.5)))
}
}
Expand All @@ -76,22 +75,20 @@ for(i in 1:length(names(all_data@pca))){
### Pagerank Log Ratio


```{r fig.align='center',warning=FALSE,echo=FALSE,eval=TRUE}
```{r fig.align='center',warning=FALSE,echo=FALSE}
for(i in 2:length(names(all_data@rankings))){
curr <- names(all_data@rankings)[i]
if(str_detect(curr, '_x_', negate = FALSE) & str_detect(curr, 'ggi', negate = FALSE)){
tmp <- top_n(all_data@rankings[[curr]],20,abs(.data$Pagerank))
signal <- ifelse(tmp$Pagerank < 0, 'negative','positive')
p1<-ggplot(tmp, aes(x=Pagerank,y=reorder(nodes,Pagerank),fill=signal))+
print(ggplot(tmp, aes(x=Pagerank,y=reorder(nodes,Pagerank),fill=signal))+
geom_bar(stat="identity")+
scale_fill_manual(values = c(Blue2DarkOrange18Steps[4],Blue2DarkOrange18Steps[14]))+
theme_minimal()
print(p1)
theme_minimal())
}
}
```


### PCA GCI Table

```{r fig.align='center',warning=FALSE,echo=FALSE}
Expand Down Expand Up @@ -129,7 +126,6 @@ for(i in 1:length(names(all_data@pca))){
```
`r paste(knitr::knit(text = out), collapse = '\n')`


### Most significant deregulated pathway per topological measure
*Generates a heatmap of the most significant differentially active KEGG-pathways based on the top 100 deregulated genes.*

Expand All @@ -156,9 +152,32 @@ for(i in 1:length(names(all_data@tables))){
curr <- names(all_data@tables)[i]
if(str_detect(curr, '_x_', negate = FALSE)){
for(gene in params$obj2){
plot_sankey(all_data@tables[[curr]],
target=gene,plt_name=paste0(curr,' ',gene))
suppressWarnings({plot_sankey(all_data@tables[[curr]],
target=gene,plt_name=paste0(curr,' ',gene))})
}
}
}
```

## LR analysis data

```{r fig.align='center', fig.height=5, fig.width=8,warning=FALSE,echo=F}
out <- c()
out1 <- list()
for(i in 1:length(names(all_data@tables))){
curr <- names(all_data@tables)[i]
if(str_detect(curr, '_x_', negate = FALSE)){
rmd_title <- paste0(curr,'_tbl')
knit_expanded <- paste0("```{r results='",rmd_title,"', echo=FALSE, warning=FALSE}
\n\n datatable(all_data@tables[['",curr,"']][,c('Ligand.Cluster','Receptor.Cluster','Ligand','Receptor' ,'LRScore')],caption='",curr,"', extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) \n\n```")
out <- c(out,knit_expanded)
out1[[curr]] <-knit_expanded
}
}
```

`r paste(knitr::knit(text = out), collapse = '\n')`
83 changes: 7 additions & 76 deletions inst/templates/Single_Condition_cgi.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,19 +26,6 @@ require("DT")
require(ggrepel)
```
```{r message=FALSE, warning=FALSE, echo=FALSE, include=FALSE}
require(igraph)
require(dplyr)
require(tibble)
require(tidyr)
require(stringr)
require(patchwork)
require(CrossTalkeR)
require(factoextra)
require(ComplexHeatmap)
require("DT")
require(ggrepel)
```


### PCA CGI
Expand All @@ -57,15 +44,15 @@ for(i in 1:length(names(all_data@pca))){
rmd_title1 <- paste0(curr,'_pca')
x <- max(abs(all_data@pca[[curr]]$x[,1]))
y <- max(abs(all_data@pca[[curr]]$x[,2]))
z_x <- all_data@pca[[curr]]$x[,1]
z_y <- all_data@pca[[curr]]$x[,2]
ver_zx <- ifelse(abs(z_x)>2*all_data@pca[[curr]]$sdev[1],1,0)
ver_zy <- ifelse(abs(z_y)>2*all_data@pca[[curr]]$sdev[2],1,0)
print(fviz_pca_biplot(all_data@pca[[curr]],
z_x <- data@pca[[curr]]$x[,1]
z_y <- data@pca[[curr]]$x[,2]
ver_zx <- ifelse(abs(z_x)>2*data@pca[[curr]]$sdev[1],1,0)
ver_zy <- ifelse(abs(z_y)>2*data@pca[[curr]]$sdev[2],1,0)
print(fviz_pca_biplot(data@pca[[curr]],
axes = c(1,2),
pointshape = 21, pointsize = 0.5,labelsize = 12,
repel = TRUE,max.overlaps=100,label='var')+
geom_label_repel(aes(label=ifelse(ver_zx & ver_zy,rownames(all_data@pca[[curr]]$x),NA)),hjust=0, vjust=0,size = 7)+
geom_label_repel(aes(label=ifelse(ver_zx & ver_zy,rownames(data@pca[[curr]]$x),NA)),hjust=0, vjust=0,size = 7)+
xlim(-x, x)+
ylim(-y, y)+
ggtitle(curr)+
Expand All @@ -77,44 +64,9 @@ for(i in 1:length(names(all_data@pca))){
```


### PCA GCI Table



### PCA Tables

```{r fig.align='center',warning=FALSE,echo=FALSE}
out <- c()
out1 <- list()
for(i in 1:length(names(all_data@pca))){
curr <- names(all_data@pca)[i]
if(!str_detect(curr, '_x_', negate = FALSE) & str_detect(curr, '_ggi', negate = FALSE)){
rmd_title <- paste0(curr,'_tbl')
rmd_title1 <- paste0(curr,'_pca')
title <- paste0('\n\n### Table PCA CGI ',curr)
knit_expanded <- paste0("```{r , results='",rmd_title,"', echo=FALSE, warning=FALSE}\n\n
pca <- all_data@pca[['",curr,"']]$x[,1:2]
pca[,1] <- round(pca[,1],6)
pca[,2] <- round(pca[,2],6)
ranking <- cbind(all_data@rankings[['",curr,"']][,2:dim(all_data@rankings[['",curr,"']])[2]],pca[all_data@rankings[['",curr,"']]$nodes,])
datatable(ranking,
caption='",curr,"',
extensions = 'Buttons',
options = list(dom = 'Bfrtip',
buttons = c('copy',
'csv',
'excel',
'pdf', 'print'),
autoWidth = FALSE
)
)
```")
out <- c(out,title,knit_expanded)
out1[[curr]] <-knit_expanded
}
}
```
`r paste(knitr::knit(text = out), collapse = '\n')`

### Most significant deregulated pathway per topological measure

*Generates a heatmap of the most significant differentially active KEGG-pathways based on the top 100 deregulated genes*
Expand All @@ -141,24 +93,3 @@ for(i in names(all_data@annot)){
}
}
```

## LR analysis data

```{r fig.align='center', fig.height=5, fig.width=8,warning=FALSE,echo=F}
out <- c()
out1 <- list()
for(i in 1:length(names(all_data@tables))){
curr <- names(all_data@tables)[i]
if(!str_detect(curr, '_x_', negate = FALSE)){
rmd_title <- paste0(curr,'_tbl')
knit_expanded <- paste0("```{r results='",rmd_title,"', echo=FALSE,warning=F}
\n\n datatable(all_data@tables[['",curr,"']][,",params$selcln,"],caption='",curr,"', extensions = 'Buttons', options = list(
dom = 'Bfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))) \n\n```")
out <- c(out,knit_expanded)
out1[[curr]] <-knit_expanded
}
}
```

`r paste(knitr::knit(text = out), collapse = '\n')`

0 comments on commit 1054f8d

Please sign in to comment.