<%@meta title="MAT reproducibility: MAT versus external MAT software"%>
<%@meta author="Henrik Bengtsson, Mark Robinson"%>

# <%@meta name="title"%>

by <%@meta name="author"%>

This test verifies that aroma.affymetrix can reproduce the estimates of the MAT (Model-based Analysis of Tiling arrays) algorithm as provided by the original [MAT] software.

<%
library("R.utils")
use("R.devices")
verbose <- Arguments$getVerbose(-8, timestamp=TRUE)
options(digits=4L)
plotDensity <- aroma.light::plotDensity
%>

## Setup
```r
<%=withCapture({
use("aroma.affymetrix")
use("gsmoothr")         # MatSmoothing
use("matrixStats")      # colMedians()
use("limma")            # makeContrast()
})%>
```


## Data
```r
<%=withCapture({
dataset <- "GSE24546";
tags <- "testset";
chiptype <- "Hs_PromPR_v02";
sampleNamesMap <- c(
  GSM605951="Prec1_MeDNA_Input1",
  GSM605952="Prec1_MeDNA_IP2",
  GSM605953="Prec1_MeDNA_IP1"
);

cdf <- AffymetrixCdfFile$byChipType(chiptype);
cdf

csR <- AffymetrixCelSet$byName(dataset, tags=tags, cdf=cdf);
csR
})%>
```

## MAT normalization

### MAT normalization by aroma.affymetrix

Normalize the data using the MAT model:
```r
<%=withCapture({
mn <- MatNormalization(csR)
mn
csM <- process(mn, verbose=more(verbose, 3))
csM
})%>
```

Convert data set such that it maps to the "unique" CDF:
```r
<%=withCapture({
csU <- convertToUnique(csM, verbose=verbose)
csU
setFullNamesTranslator(csU, function(names, ...) { sampleNamesMap[names] })
})%>
```

### MAT normalization by the original MAT software

```r
<%=withCapture({
# MAT normalized signals
normFile <- "Prec1_MeDNA_600_IP1-Input.tsv"
tsv <- TabularTextFile(filename=normFile, path=getPath(csR))
tsv

# Sample names ran on external MAT software
sampleNames <- getColumnNames(tsv)
sampleNames <- setdiff(sampleNames, c("Chr", "Pos"))
sampleNames <- gsub("[.]CEL$", "", sampleNames)
sampleNames
})%>
```

### Comparisons
```r
<%=withCapture({
# Sanity check
stopifnot(all(is.element(sampleNames, getNames(csU))))

# Corresponding aroma subset
csUt <- csU[sampleNames]

# Compare common units with prefix "chr1F".
cdfU <- getCdf(csU)
units <- indexOf(cdfU, "^chr1F")
cells <- getCellIndices(cdfU, units=units, stratifyBy="pm",
                        unlist=TRUE, useNames=FALSE)

# Get the chromosomal positions of these cells
acp <- AromaCellPositionFile$byChipType(getChipType(cdfU))
pos <- acp[cells,2,drop=TRUE]

# Order cells by chromsomal position
o <- order(pos)
pos <- pos[o]
cells <- cells[o]

# Read MAT signals
colClasses <- c(Chr="character", Pos="integer",
                rep("numeric", times=length(sampleNames)))
names(colClasses)[-(1:2)] <- sampleNames
data <- readDataFrame(tsv, colClasses=colClasses, nrow=435000)
data <- subset(data, (Chr == "chr1" & Pos %in% pos))

# Order as (pos,yN)
o <- match(data$Pos, pos)
# Sanity check
stopifnot(all(is.finite(o)))
data <- data[o,,drop=FALSE]

# Extract signals
YMAT <- as.matrix(data[,-(1:2)])
rownames(YMAT) <- NULL
colnames(YMAT) <- sampleNames

Y <- log2(extractMatrix(csUt, cells=cells))

# Sanity check
stopifnot(identical(dim(Y), dim(YMAT)))
})%>
```

Visual comparison of confidence scores:

<% for (sampleName in sampleNames) { %>
![](<%=toPNG(getFullName(csU), tags=c(sampleName, "MatNormalization_vs_MAT"), aspectRatio=1, { 
  xlab <- expression(log[2](y[MAT]))
  ylab <- expression(log[2](y))
  plot(YMAT[,sampleName], Y[,sampleName], pch=".", xlab=xlab, ylab=ylab)
  abline(a=0, b=1, col="red", lwd=2, lty=3)
  stext(side=3, pos=0, sampleName)
  stext(side=3, pos=1, "Chr01")
  stext(side=4, pos=1, sprintf("n=%d", nrow(Y)))
  stext(side=4, pos=0, getFullName(csU))
})%>)  

<% } # for (sampleName ...) %>
_Figure: Pairwise MAT estimates from aroma.affymetrix and the original MAT software across <%=length(csU)%> <%=chiptype%> arrays._


Average signal differences:
```r
<%=withCapture({
D2 <- (Y - YMAT)^2
avgDiff <- colMedians(D2, na.rm=TRUE)
names(avgDiff) <- colnames(D2)
avgDiff

# Sanity check
stopifnot(all(avgDiff < 0.001));
})%>
```


## Mat smoothing by aroma.affymetrix

### Design #1
```r
<%=withCapture({
sampleNames <- getNames(csU)
design1 <- makeContrasts(Prec1_MeDNA_IP1-Prec1_MeDNA_Input1, levels=sampleNames)
colnames(design1) <- "Prec1_IP1_minus_Input"
design1

ms1 <- MatSmoothing(csU, design=design1, probeWindow=600, tag="singleIP")
ms1
csMS1 <- process(ms1, units=NULL, verbose=verbose)
csMS1
})%>
```


### Design #2
```r
<%=withCapture({
sampleNames <- getNames(csU)
design2 <- makeContrasts(Prec1_MeDNA_IP1 + Prec1_MeDNA_IP2-Prec1_MeDNA_Input1, levels=sampleNames)
colnames(design2) <- "Prec1_IPs_minus_Input"

ms2 <- MatSmoothing(csU, design=design2, probeWindow=800, tag="multipleIP")
ms2
csMS2 <- process(ms2, units=NULL,verbose=verbose)
csMS2

# Read signals
# Compare common units with prefix "chr1F".
cdfU <- getCdf(csU)
units <- indexOf(cdfU, "^chr1F")
cells <- getCellIndices(cdfU, units=units, stratifyBy="pm",
                        unlist=TRUE, useNames=FALSE)

# Get the chromosomal positions of these cells
acp <- AromaCellPositionFile$byChipType(getChipType(cdfU))
pos <- acp[cells,2,drop=TRUE]

# Order cells by chromsomal position
o <- order(pos)
pos <- pos[o]
cells <- cells[o]

# Extract the corresponding signals (on the log2 scale)
Y1 <- log2(extractMatrix(csMS1, cells=cells, verbose=verbose))
Y2 <- log2(extractMatrix(csMS2, cells=cells, verbose=verbose))
Y <- cbind(Y1, Y2)
})%>
```

### MAT smoothing by the original MAT software
```r
<%=withCapture({
# Files with native-MAT summarized signals
summaryFiles <- c("Prec1_MeDNA_600_IP1-Input.bar.txt",
                  "Prec1_MeDNA_800_IPs-Input.bar.txt")
barList <- lapply(summaryFiles, FUN=function(filename) {
  columnNames <- c("chromosome", "position", "signal")
  TabularTextFile(filename, path=getPath(csR), columnNames=columnNames)
})
barList

# Read signals
YMAT <- sapply(barList, FUN=function(bar) {
  columnNames <- c("chromosome", "position", "signal")
  data <- readDataFrame(bar, colClasses=colClasses("cin"), nrow=435000)

  # Extract the subset available in the aroma.affymetrix estimate
  data <- subset(data, chromosome == "chr1" & position %in% pos)

  # Order by position
  o <- order(data$position)
  data <- data[o,,drop=FALSE]

  # Extract the external estimates
  y <- data$signal

  # External score that are exactly zero, they are NAs
  y[y == 0] <- NA_real_

  y
})
colnames(YMAT) <- colnames(Y)
})%>
```

Visual comparison of confidence scores:

<% for (designName in colnames(Y)) { %>
![](<%=toPNG(getFullName(csU), tags=c(designName, "MatSmoothing_vs_MAT"), {
  xlab <- expression(log[2](y[MAT]))
  ylab <- expression(log[2](y))
  plot(YMAT[,designName], Y[,designName], pch=".", xlab=xlab, ylab=ylab)
  abline(a=0, b=1, col="red", lwd=2, lty=3)
  stext(side=3, pos=0, designName)
  stext(side=3, pos=1, "Chr01")
  stext(side=4, pos=1, sprintf("n=%d", nrow(Y)))
  stext(side=4, pos=0, getFullName(csU))
})%>)  
<% } # for (designName ...) %>

_Figure: Pairwise MAT smooth estimates from aroma.affymetrix and the original MAT software for <%=ncol(Y)%> designs._

Average signal differences:
```r
<%=withCapture({
D <- (Y - YMAT)^2
avgDiff <- colMedians(D, na.rm=TRUE)
names(avgDiff) <- colnames(D)
avgDiff

# Sanity check
stopifnot(all(avgDiff < 0.003))
})%>
```


## Appendix
```r
<%=withCapture({
sessionInfo()
})%>
```

--------------------------------------------------------------------
Last generated: <%=format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC%z")%>.
Powered by [RSP](http://cran.r-project.org/package=R.rsp).


[MAT]: http://liulab.dfci.harvard.edu/MAT/ "Model-based Analysis of Tiling-array"
