---
title: "The RNA Centric Analysis System Report"
author: "Bora Uyar, Dilmurat Yusuf, Ricardo Wurmus, Altuna Akalin"
date: '`r Sys.time()`'
params:
  dbPath: './test.RCASdb.sqlite'
  sampleTablePath: ''
  workdir: '.'
---

```{r global_options, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, fig.height = 4.5, fig.width = 8)
knitr::opts_knit$set(progress = FALSE, root.dir = params$workdir)
```

```{r setup}
suppressWarnings(suppressMessages(library(RCAS)))
# Connect to sqlite database
mydb <- RSQLite::dbConnect(RSQLite::SQLite(), params$dbPath)

# Read sample table and check format
sampleTable <- read.table(params$sampleTablePath, header = TRUE,stringsAsFactors = FALSE)
if(sum(c('sampleName', 'sampleGroup') %in% colnames(sampleTable)) != 2) {
  stop("The sample table must consist of at least 
       two columns (separated by white space(s)) 
       with headers 'sampleName' and 'sampleGroup'. 
       See ",params$sampleTable)
}

if(nrow(sampleTable) < 2) {
  stop("The sample table must contain at least one entry. 
       See ",sampleTable)
}

#set up which chunks to run depending on which tables are available in mydb
#1. geneOverlaps table
evalGeneOverlaps <- FALSE
if(RSQLite::dbExistsTable(mydb, 'geneOverlaps')){
  geneOverlaps <- RSQLite::dbReadTable(mydb, 'geneOverlaps')
  samplesNotFound <- setdiff(sampleTable$sampleName, colnames(geneOverlaps))
  if(length(samplesNotFound) > 0){
    warning("Samples with names '",paste0(samplesNotFound, collapse = ', '),
            "' do not exist in 'geneOverlaps' table. Skipping this table")
    } else {
      evalGeneOverlaps <- TRUE
      geneOverlaps <- subset(geneOverlaps, select = sampleTable$sampleName)
    }
  } 

#2. annotationSummaries table
evalAnnotationSummaries <- FALSE
if(RSQLite::dbExistsTable(mydb, 'annotationSummaries')){
  AS <-  RSQLite::dbReadTable(mydb, 'annotationSummaries')
  annotationSummaries <- as.matrix(AS[,c(-1)])
  rownames(annotationSummaries) <- AS$sampleName
  samplesNotFound <- setdiff(sampleTable$sampleName, rownames(annotationSummaries))
  
  if(length(samplesNotFound) > 0) {
    warning("Samples with names '",paste0(samplesNotFound, collapse = ', '),
          "' do not exist in 'annotationSummaries' table. Skipping this table")
    } else {
      evalAnnotationSummaries <- TRUE
      annotationSummaries <- annotationSummaries[sampleTable$sampleName,]
    }
} 

#3. discoveredMotifs table 
evalMotifDiscovery <- FALSE
if(RSQLite::dbExistsTable(mydb, 'discoveredMotifs')) {
  motifData <- RSQLite::dbReadTable(mydb, 'discoveredMotifs')
  samplesNotFound <- setdiff(sampleTable$sampleName, motifData$sampleName)
  if(length(samplesNotFound) > 0) {
    warning("Samples with names '",paste0(samplesNotFound, collapse = ', '),
            "' do not exist in 'discoveredMotifs' table. Skipping this table")
    } else {
      evalMotifDiscovery <- TRUE
      motifData <- motifData[motifData$sampleName %in% sampleTable$sampleName,]
    }
} 

#4. featureBoundaryCoverageProfiles table
evalCoverageProfiles <- FALSE 
if(RSQLite::dbExistsTable(mydb, 'featureBoundaryCoverageProfiles')) {
  cvg <-  RSQLite::dbReadTable(mydb, 'featureBoundaryCoverageProfiles')
  samplesNotFound <- setdiff(sampleTable$sampleName, cvg$sampleName)
  if(length(samplesNotFound) > 0) {
    warning("Samples with names '",paste0(samplesNotFound, collapse = ', '),
            "' do not exist in 'featureBoundaryCoverageProfiles' table. Skipping this table")
    } else {
      evalCoverageProfiles <- TRUE
      cvg <- cvg[cvg$sampleName %in% sampleTable$sampleName,]
      cvg$sampleGroup <- sampleTable[match(cvg$sampleName, sampleTable$sampleName),]$sampleGroup
    }
}

#initialize figure and table counts for captions
figureCount <- 1
tableCount <- 1
```


```{r geneOverlapsHeader, results='asis', eval=evalGeneOverlaps}
cat("# Distance of samples by various metrics\n")
```


```{r geneOverlapsFigureCaption, results='asis', eval=evalGeneOverlaps}
cat('## Jaccard distance based on shared target genes\n')

cat("**Figure",figureCount,":** Jaccard distance based on shared target genes. 
Here we plot the distance matrix between samples based on the Jaccard index computed for each pairwise sample 
based on how many genes the compared pair of samples co-overlap. \n")
```

```{r geneOverlaps, eval = evalGeneOverlaps}
SM <- as.matrix(proxy::dist(x = as.matrix(geneOverlaps), method = 'Jaccard', by_rows = FALSE, diag = TRUE, upper = TRUE))
pheatmap::pheatmap(SM, display_numbers = FALSE)
figureCount <- figureCount + 1
```

```{r annotationSummariesFigureCaption, results = 'asis', eval = evalAnnotationSummaries}
cat("## Clustering of samples based on overlaps with transcript features\n")
cat("**Figure",figureCount,":** Clustering of samples based on overlaps with transcript features\n")
```

```{r annotationSummaries, eval = evalAnnotationSummaries}
annDF <- data.frame('sampleGroup' = sampleTable[match(rownames(annotationSummaries), sampleTable$sampleName),]$sampleGroup)
rownames(annDF) <- rownames(annotationSummaries)
pheatmap::pheatmap(t(annotationSummaries), scale = 'column', 
         annotation_col = annDF)
figureCount <- figureCount + 1
```

```{r motifDiscoveryHeader, results = 'asis', eval = evalMotifDiscovery}
cat("# Motif Discovery\n")
```

```{r motif_logos_prepare, eval = evalMotifDiscovery}
featuresToPlot <- c('transcripts', 'promoters', 'fiveUTRs', 'threeUTRs', 'introns', 'cds')
samplesToPlot <- sort(unique(motifData$sampleName))
motifLogos <- lapply(X = samplesToPlot,
       FUN = function(s) {
         logos <- lapply(featuresToPlot, function(f) {
           matches <- motifData[motifData$sampleName == s &
                                  motifData$feature == f,]$matches
           matches <- unlist(Biostrings::strsplit(matches, ';'))
           p <- ggplot2::ggplot() + 
             ggseqlogo::geom_logo(data = matches,
                                  namespace = c('A', 'C', 'G', 'T', 'N', 'O','E'), 
                                  method = 'bits') +
             coord_fixed() + 
             ggseqlogo::theme_logo() %+replace%
             theme(axis.text.x = element_blank(), 
                   axis.text.y = element_blank(), 
                   axis.title.y = element_blank()) + 
             labs(x = f)
          return(p)}
          )
       return(cowplot::plot_grid(plotlist = logos, nrow = 1))
       })
```

```{r motif_logos_plotFigureCaption, results = 'asis', eval = evalMotifDiscovery}
cat("**Figure",figureCount,":** Feature specific motifs discovered for each sample\n")
```

```{r motif_logos_plot, eval = evalMotifDiscovery, fig.width=10, fig.height=ifelse(evalMotifDiscovery,  length(samplesToPlot)*1.4, 10)}
#try to reserve 1.3 inches per each sample (for each sample there is one row of motifs and the height is dynamically adjusted 
# as "number of samples multiplied by the height needed for one sample")

p <- cowplot::plot_grid(plotlist = motifLogos, nrow = length(samplesToPlot), ncol = 1, labels = samplesToPlot, scale = 1)
print(p)
figureCount <- figureCount + 1
```

```{r coverageProfilesHeader, results = 'asis', eval = evalCoverageProfiles}
cat("# Feature Boundary Coverage Profiles\n")
```

```{r coverageProfilesLinePlotFigureCaption, results = 'asis', eval = evalCoverageProfiles}
cat("## Smoothed line plots\n")
cat("**Figure",figureCount,":** Feature boundary coverage profiles for each sample\n")
```

```{r coverage_profiles, eval = evalCoverageProfiles, fig.width=8, fig.height=10}
#scale meanCoverage values by sampleName and feature
cvgScaled <- do.call(rbind, 
                     lapply(split(cvg, cvg$sampleName),
                            FUN = function(df) {
                              df$scaledCoverage <- scale(df$meanCoverage)
                              return(df)
                              }))

p <- plotly::ggplotly(ggplot2::ggplot(cvgScaled, aes(x = bases, y = scaledCoverage)) + 
                        geom_vline(xintercept = 0, color = 'gray') +
                        facet_grid(feature ~ boundary) + 
                        geom_smooth(aes(color = sampleGroup, alpha = scaledCoverage)) + theme_minimal())
layout(p)
figureCount <- figureCount + 1
```


```{r pca_coverageProfiles, eval = evalCoverageProfiles}
plotPCA <- function(cv, title = '') {
  cvM <- dcast(cv, sampleName ~ boundary + bases, value.var = 'meanCoverage')
  M <- as.matrix(cvM[,-1])
  rownames(M) <- cvM[,1]
  pca1 <- prcomp(M)
  scores = as.data.frame(pca1$x)
  scores$sampleName <- cv[match(rownames(scores), cv$sampleName),]$sampleName
  scores$sampleGroup <- cv[match(rownames(scores), cv$sampleName),]$sampleGroup

  p <- ggplot2::ggplot(data = scores, aes(x = PC1, y = PC2, label = sampleName)) +
    geom_point(aes(color = sampleGroup), size = 4) +
    geom_hline(yintercept = 0, colour = "gray65") +
    geom_vline(xintercept = 0, colour = "gray65") +
    labs(title = title) + theme_minimal(base_size = 18) %+replace% 
    theme(legend.position = 'bottom', legend.title = element_blank())
  return(p)
}

pcaPlots <- lapply(unique(cvg$feature), function(f) {
  plotPCA(cv = cvg[cvg$feature == f,], title = f)
})
names(pcaPlots) <- unique(cvg$feature)
```

```{r pca_coverageProfilesPlot, results='asis', echo = FALSE, eval = evalCoverageProfiles}
cat("## PCA plots {.tabset}\n")
for (i in 1:length(pcaPlots)) {
  cat("### ",names(pcaPlots)[i],"\n")
  print(pcaPlots[[i]])
  cat('\n\n')
}
figureCount <- figureCount + 1
```

```{r exit}
RSQLite::dbDisconnect(mydb)
```

# Acknowledgements

RCAS is developed in the group of 
[Altuna Akalin](http://bioinformatics.mdc-berlin.de/team.html#altuna-akalin-phd)
(head of the Scientific Bioinformatics Platform) by
[Bora Uyar](http://bioinformatics.mdc-berlin.de/team.html#bora-uyar-phd)
(Bioinformatics Scientist),
[Dilmurat Yusuf](http://bioinformatics.mdc-berlin.de/team.html#dilmurat-yusuf-phd)
(Bioinformatics Scientist) and 
[Ricardo Wurmus](http://bioinformatics.mdc-berlin.de/team.html#ricardo-wurmus)
(System Administrator) at the Berlin Institute of Medical Systems Biology
([BIMSB](https://www.mdc-berlin.de/13800178/en/bimsb))
at the Max-Delbrueck-Center for Molecular Medicine
([MDC](https://www.mdc-berlin.de)) in Berlin.

RCAS is developed as a bioinformatics service as part of
the [RNA Bioinformatics Center](http://www.denbi.de/index.php/rbc),
which is one of the eight centers of
the German Network for Bioinformatics Infrastructure
([de.NBI](http://www.denbi.de/)).  

# Session Information
```{r sessionInfo}
sessionInfo()
```
