### Script to produce Figure 2 of Sterratt, D. C. & Hjorth,
### J. J. J. (2013) "Retioncollicular mapping explained?"
### Vis. Neurosci. doi:10.1017/S0952523813000254
###
### To run this script:
###
### 1. Install R from http://www.r-project.org
### 2. Start R
### 3. Type:
###    source("figures.R")
###
### The first time the script is run it may take a while due to
### downloading an R add-on package. Figures files should appear in
### the working directory. To find out what the working directory is,
### type "getwd()" in R. The files are entitled "figure1-original.pdf"
### (the gradients from Figure 1) and "figure2-original.tiff" (Figure
### 2 in its entirety).
###

if (require(Hmisc)) {
  install.packages("Hmisc")
  library(Hmisc)
} 

## Retinal NT (x) and SC DV (y) coordinates
x <- seq(0, 1, len=110)
y <- seq(0, 1, len=100)

## Index of representative point on N-T axis and number of samples
isamp <- c(10, 100)                     # RGC indicies to show points for
nsamp <- 7                              # Number of points sampled
nselect <- 3                            # Number of points selected

### Grimbert and Cang's arborization functions

## G&C's forward signalling parameters
rF <- 20
bNF <- 140/100
bTF <- 35/100

## G&C's reverse signalling parameters
rR <- -20
bNR <- 45/100
bTR <- -15/100

## Forward signalling arborization probability PF
BF <- outer((bTF - bNF)*x + bNF, y, "-")
PFC = 1/(1 + exp(-rF*BF))

## Reverse signalling arborization probability PR
BR <- outer((bTR - bNR)*x + bNR, y, "-")
PRC = 1/(1 + exp(-rR*BR))

## Combined arborization probability
PC <- PFC * PRC

### Our gradients

## Type of gradient. Can be "original" (used in J. Neurosci. JC
## submission), "matched" (as the name suggests) or "johannes" (used
## in Johannes' simulations).
gradients <- "original"

## Forward gradients
RF <- NULL
LF <- NULL
if (gradients == "matched") {
  RF <- function(x) {(1.05 + 0.26*exp(2.3*x))/1.05}
  LF <- function(y) {(1.05 + 0.26*exp(2.3*y))/1.05}
}
if (gradients == "original") {
  RF <- function(x) {(1.05 + 0.26*exp(2.3*x))/1.05}
  LF <- function(y) {exp(2.1*(y-1))}
}
if (gradients == "johannes") {
  RF <- function(x) {(1.0202 + 0.2526*exp(2.3*x))/(1.0202 + 0.2526*exp(2.3*1))/3.54}
  LF <- function(y) { (0.2882 + 0.0714*exp(2.3*(y-1)))/(0.2882 + 0.0714*exp(2.3*0))}
}

## Forward signalling arborization probability PF
PF <- 1/outer(RF(x), LF(y))
PF <- PF/max(PF)

## Reverse gradients
RR <- NULL
LR <- NULL
if (gradients == "matched") {
  RR <- function(x) {(1.05 + 0.26*exp(2.3*(1-x)))/1.05} 
  LR <- function(y) {(1.05 + 0.26*exp(2.3*(1-y)))/1.05}
}
if (gradients == "original") {
  RR <- function(x) {1+1.7*exp(-x)} 
  LR <- function(y) {1+0.6*exp(-2.6*y)} 
}
if (gradients == "johannes") {
  RR <- function(x) {(0.2882 + 0.0714*exp(2.3*x))/(0.2882 + 0.0714*exp(-2.3*0))} 
  LR <- function(y) {(0.2882 + 0.0714*exp(-2.3*y))/(0.2882 + 0.0714*exp(-2.3*0))} 
}

## Reverse signalling arborization probability PR
PR <- 1/outer(RR(x), LR(y))
PR <- PR/max(PR)

## Combined arborization probability
P <- PF * PR
P <- P/max(P)

###
### Plotting of arborization probabilities
###

## Function to draw panel labels
panlabel <- function(panlabel, line=-0.5) {
  mtext(panlabel, side=3, adj=-par("plt")[1]/(par("plt")[2]-par("plt")[1]),
        line=line, font=2, ps=9)
}

## Colours used for displaying probability functions
cols <- terrain.colors(110, alpha=0.5)[1:100]

## Start plotting.
## Result will be in file "figure2-original.tiff"
tiff(paste0("figure2-", gradients, ".tiff"),
     width=17/2.54, height=9/2.54, pointsize=10,
     type="cairo",
     units="in", res=300, compression="lzw")
## pdf(paste0("figure2-", gradients, ".pdf"),
##     width=17/2.54, height=9/2.54, pointsize=10)
## postscript(paste0("figure2-", gradients, ".eps"),
##            width=17/2.54, height=9/2.54, pointsize=10,
##            onefile=FALSE)
par(mfrow=c(2,4))
par(mgp=c(0.4, 0.4, 0))
par(mar=c(1.5, 2, 0.5, 0.5))
par(oma=c(0, 0, 2.2, 0), xpd=TRUE)
par(cex=1)
par(las=1, tcl=-0.25)

##
## G&C probabilities
##

contour.levels <- c(0.9, 0.5, 0.1)

## Forward
image(x, y, PFC, zlim=c(0, 1),
      #col=rainbow(100, start=0.5, end=0)
      col=cols,
      xlab="", ylab="SC",
      xaxt="n", yaxt="n",
      main="")
mtext(expression(paste("Forward signalling, ", italic(P)[F])), line=0.5)
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, PFC, add=TRUE, levels=contour.levels)
panlabel("A")

## Reverse
image(x, y, PRC, zlim=c(0, 1),
      col=cols,
      xlab="", ylab="",
      xaxt="n", yaxt="n",
      main="")
mtext(expression(paste("Reverse signalling, ", italic(P)[R])), line=0.5)
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, PRC, add=TRUE, levels=contour.levels)
panlabel("B")

## Combined
image(x, y, PC, zlim=c(0, 1),
      col=cols,
      xlab="", ylab="",
      xaxt="n", yaxt="n")
mtext(expression("Probability"), line=1.5)
mtext(expression(paste("of arborization ", italic(P)[A])), line=0.5)
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, PC, add=TRUE, levels=contour.levels) 
panlabel("C")

## Representative points
for (i in isamp)  {
  js <- sample(1:length(y), nsamp, replace=TRUE, prob=PC[i,])
  s <- sort(PC[i,js], decreasing=TRUE, index.return=TRUE)
  points(rep(x[i], nselect), y[js[s$ix[1:nselect]]], pch=19, cex=0.5)
  points(rep(x[i], nsamp - nselect), y[js[s$ix[(nselect+1):nsamp]]], cex=0.5)
}

## Nasotemporal slice
plot(x, PFC[,50], type="l",
     xlab="", ylab=expression(italic(P)[F]),
     xaxt="n", ylim=c(0,1), yaxt="n")
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, at=c(0,1))
mtext(expression("Forward signalling") , line=1.5)
mtext("for axons on N-T axis", line=0.7)
panlabel("D")

##
## Our gradients
##

contour.levels <- seq(0, 1, by=0.1)

## Forward
image(x, y, PF, zlim=c(0, 1),
      col=cols,
      xlab="Retina", ylab="SC",
      xaxt="n", yaxt="n",
      main="")
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, PF, add=TRUE, levels=contour.levels)
panlabel("E")

## Reverse
image(x, y, PR, zlim=c(0, 1),
      col=cols,
      xlab="Retina", ylab="",
      xaxt="n", yaxt="n",
      main="")
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, PR, add=TRUE, levels=contour.levels)
panlabel("F")

## Combined
image(x, y, P, zlim=c(0, 1),
      col=cols,
      xlab="Retina", ylab="",
      xaxt="n", yaxt="n")
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, labels=c("A", "P"), at=c(0,1))
contour(x, y, P, add=TRUE, levels=contour.levels)
panlabel("G")

## Representative points
for (i in isamp)  {
  js <- sample(1:length(y), nsamp, replace=TRUE, prob=P[i,])
  s <- sort(P[i,js], decreasing=TRUE, index.return=TRUE)
  points(rep(x[i], nselect), y[js[s$ix[1:nselect]]], pch=19, cex=0.5)
  points(rep(x[i], nsamp - nselect), y[js[s$ix[(nselect+1):nsamp]]], cex=0.5)
}

## Nasotemporal slice
plot(x, 1/RF(x), type="l",
     xlab="Retina", ylab=expression(italic(P)[F]),
     xaxt="n", ylim=c(0,1), yaxt="n")
axis(1, labels=c("N", "T"), at=c(0,1))
axis(2, at=c(0,1))
panlabel("H")

dev.off()

###
### Plot of gradients (incorporated in Fig. 1)
### 
pdf(paste0("figure1-", gradients, ".pdf"),
    width=17/2.54, height=9.8/2.54, pointsize=10)
par(mfcol=c(2,2))

## Retina (forwards)
plot(NA, NA, ylim=c(0, max(RF(x))), xlim=c(0, 1),
     xlab="Retina N-T axis", ylab="", 
     xaxt="n", yaxt="n", bty="n")
polygon(c(0, x, 1), c(0, RF(x), 0), col="purple", border=NA)

## Retina (reverse)
plot(NA, NA, ylim=c(0, max(RR(x))), xlim=c(0, 1),
     xlab="Retina N-T axis", ylab="", 
     xaxt="n", yaxt="n", bty="n")
polygon(c(0, x, 1), c(0, RR(x), 0), col="blue", border=NA)

## SC (forwards)
plot(NA, NA, ylim=c(0, max(LF(y))), xlim=c(0, 1),
     xlab="SC A-P axis", ylab="", 
     xaxt="n", yaxt="n", bty="n")
polygon(c(0, y, 1), c(0, LF(y), 0), col="purple", border=NA)

## SC (reverse)
plot(NA, NA, ylim=c(0, max(LR(y))), xlim=c(0, 1),
     xlab="SC A-P axis", ylab="", 
     xaxt="n", yaxt="n", bty="n")
polygon(c(0, y, 1), c(0, LR(y), 0), col="blue", border=NA)

dev.off()