# Compare affinities of Sonic hedgehog and transcription factors involved in dorsal-ventral patterning
# (Dick, 2015. Chemical integration of proteins in signaling and development. https://doi.org/10.1101/015826)

# to reproduce the calculations in the paper, use superseded data for [Gly] and [UPBB] 20190206
add.obigt("OldAA", c("[Gly]", "[UPBB]"))

# UniProt names of the proteins
pname <- c("SHH", "OLIG2", "NKX22", "FOXA2", "IRX3", "PAX6", "NKX62", "DBX1",
  "DBX2", "NKX61", "PAX7", "GLI1", "GLI2", "GLI3", "PTC1", "SMO", "GLI3R")[1:11]

# colors modified from Dessaud et al., 2008 and Hui and Angers, 2011
fill <- c(SHH = "#c8c7c8", OLIG2 = "#f9a330", NKX22 = "#ef2b2c", FOXA2 = "#6ab0b9",
  NKX61 = "#b76775", DBX2 = "#35bcba", PAX7 = "#f6ef42",
  PAX6 = "#4d2a59", IRX3 = "#63c54e", NKX62 = "#f24e33", DBX1 = "#d4e94e",
  PTC1 = "#c7b0ee", SMO = "#8fd4ef", GLI1 = "#fcdc7e", GLI2 = "#c7e3b0", GLI3 = "#fcdc7e",
  GLI3R = "#f1b1ae")

# names for plotting
names <- c(SHH = "Shh", OLIG2 = "Olig2", NKX22 = "Nkx2.2", FOXA2 = "Foxa2",
  NKX61 = "Nkx6.1", DBX2 = "Dbx2", PAX7 = "Pax7",
  PAX6 = "Pax6", IRX3 = "Irx3", NKX62 = "Nkx6.2", DBX1 = "Dbx1",
  PTC1 = "Ptch1", SMO = "Smo", GLI1 = "Gli1A", GLI2 = "Gli2A", GLI3 = "Gli3A",
  GLI3R = "Gli3R")

# protein indices of Shh and the transcription factors
ip <- match(pname, thermo()$protein$protein)
aa <- thermo()$protein[ip, ]

# set up basis species
basis("CHNOS")
basis("NH3", -7)

# save as PDF file?
pdf <- FALSE
# draw interpretive legend?
interp <- TRUE

# set up ranges of logfO2 and logaH2O
O2 <- seq(-70, -100, length.out = 500)
H2O <- seq(0.5, -4.5, length.out = 500)
A <- affinity(H2O = H2O, O2 = O2, iprotein = ip)
# plot affinities per residue, compared to SHH
pl <- protein.length(ip)
names(A$values) <- pname
for(i in 1:length(A$values)) A$values[[i]] <- A$values[[i]] / pl[i]
A.SSH <- A$values$SHH
for(i in 1:length(A$values)) A$values[[i]] <- A$values[[i]] - A.SSH
ylab <- expression(bold(A)/2.303*italic(RT)*" vs Shh")
xlab <- expression(log*italic(a)[H[2]][O])
# set up normal plot, or plot with interpretive drawings
opar <- par(no.readonly = TRUE)
if(interp) {
  if(pdf) pdf("tfactor_interp.pdf", width=6, height=6)
  plot.new()
  plot.window(rev(range(H2O)), c(-0.7, 4.7), xaxs="i", yaxs="i")
  par(xpd=FALSE)
  clip(range(H2O)[1], range(H2O)[2], -0.3, 4.2)
} else {
  if(pdf) pdf("tfactor_affinity.pdf", width=6, height=6)
  plot(range(H2O), c(-0.5, 4.5), type="n", xaxs="i", yaxs="i", xlab=xlab, ylab=ylab, xlim=rev(range(H2O)), mgp=c(2.5, 1, 0))
}
for(i in 1:length(pl)) {
  lty <- 3
  lwd <- 1
  # highlight SHH with solid line
  if(pname[i]=="SHH") {
    lty <- 1
    lwd <- 3
  }
  lines(H2O, A$values[[i]], lty=lty, lwd=lwd)
}
# highlight lines for reaction sequence from OLIG2 to SHH
A <- A$values
names(A) <- pname
# Olig2
iOLIG2 <- A$OLIG2 > A$SHH
lines(H2O[iOLIG2], A$OLIG2[iOLIG2], col=fill["OLIG2"], lwd=3)
# Foxa2 with offset to distinguish it from Nkx6.1/Dbx2
iFOXA2 <- A$FOXA2 > A$OLIG2 & A$FOXA2 > A$NKX22
lines(H2O[iFOXA2], A$FOXA2[iFOXA2], col=fill["FOXA2"], lwd=3)
# Nkx2.2
iNKX22 <- A$NKX22 > A$FOXA2 & A$NKX22 > A$SHH
lines(H2O[iNKX22], A$NKX22[iNKX22], col=fill["NKX22"], lwd=3)
# Pax6
iPAX6 <- A$PAX6 > A$SHH
lines(H2O[iPAX6], A$PAX6[iPAX6], col=fill["PAX6"], lwd=3)
# Nkx6.1 with overstepping
iNKX61 <- A$NKX61 > A$DBX2
imax <- max(which(iNKX61))
iNKX61[1: (imax-20)] <- FALSE
lines(H2O[iNKX61], A$NKX61[iNKX61], col=fill["NKX61"], lwd=3)
# Dbx2
iDBX2 <- A$DBX2 > A$NKX61 & A$DBX2 < A$IRX3
lines(H2O[iDBX2], A$DBX2[iDBX2], col=fill["DBX2"], lwd=3)
# Irx3
iIRX3 <- A$IRX3 > A$NKX62 & A$IRX3 > A$OLIG2
lines(H2O[iIRX3], A$IRX3[iIRX3], col=fill["IRX3"], lwd=3)
# Nkx6.2
iNKX62 <- A$NKX62 > A$IRX3 & A$NKX62 > A$DBX1
lines(H2O[iNKX62], A$NKX62[iNKX62], col=fill["NKX62"], lwd=3)
# Dbx1
iDBX1 <- A$DBX1 > A$NKX62 & A$DBX1 > A$SHH
lines(H2O[iDBX1], A$DBX1[iDBX1], col=fill["DBX1"], lwd=3)
# Shh
#iSHH <- A$SHH > A$DBX1
#lines(H2O[iSHH], A$SHH[iSHH], col=fill["SHH"], lwd=3)
# the lines need names
if(interp) {
  # remove plot clip region
  par(xpd=NA)
  text(-2.12, -0.48, "Nkx2.2", srt=90)
  text(-0.87, -0.65, "Olig2", srt=90)
  text(0, -0.72, "Pax6", srt=90)
  text(0.06, 4.3, "Olig2", srt=90)
  text(-0.13, 4.3, "Irx3", srt=90)
  text(-0.77, 4.3, "Nkx6.1", srt=90)
  text(-.97, 4.3, "Dbx2", srt=90)
  text(-3.45, 4.3, "Nkx6.2", srt=90)
  text(-3.65, 4.3, "Dbx1", srt=90)
} else {
  text(-1.5, 0.5, "Nkx2.2")
  text(-0.1, 0.3, "Pax6")
  text(-0.2, 3.8, "Olig2")
  text(-0.75, 2.45, "Irx3")
  text(-1.13, 1.3, "Nkx6.1")
  text(-1.5, 1, "Dbx2")
  text(-2.4, 1.3, "Nkx6.2")
  text(-3.8, 0.3, "Dbx1")
}
text(0.3, -0.15, "Shh")
text(-4.25, 0.15, "Shh")
text(-0.47, 0.5, "Pax7", srt=-35)
text(-0.22, 2, "Foxa2", srt=-61)
# are we making an interpretive plot?
if(interp) {
  # the left,bottom x,y-position and horizontal width of the bottom gradient wedge
  xbot <- H2O[1]
  ybot <- -1.4
  wbot <- 3
  # the height of the bottom gradient wedge as a function of the x position
  hbot <- function(x) 0.3 + 0.08*(xbot - x)
  lines(c(xbot, xbot-wbot), ybot+hbot(c(xbot, xbot-wbot)))
  # draw the base and sides of the bottom gradient wedge
  lines(c(xbot, xbot-wbot), c(ybot, ybot))
  lines(rep(xbot, 2), c(ybot, ybot+hbot(xbot)))
  lines(rep(xbot, 2)-wbot, c(ybot, ybot+hbot(xbot-wbot)))
  # draw drop lines from reactions between TFs and Shh
  xNKX22 <- H2O[max(which(A$NKX22 > A$SHH))]
  lines(rep(xNKX22, 2), c(ybot, 0), lty=2)
  xOLIG2 <- H2O[max(which(A$OLIG2 > A$SHH))]
  lines(rep(xOLIG2, 2), c(ybot, 0), lty=2)
  xPAX6 <- H2O[max(which(A$PAX6 > A$SHH))]
  lines(rep(xPAX6, 2), c(ybot, 0), lty=2)
  # the left,bottom x,y-position and horizontal width of the top gradient wedge
  xtop <- H2O[2]
  ytop <- 4.7
  wtop <- 5
  # the height of the top gradient wedge as a function of the x position
  htop <- function(x) 0.4 - 0.08*(xtop - x)
  lines(c(xtop, xtop-wtop), ytop+htop(c(xtop, xtop-wtop)))
  # draw the base and sides of the top gradient wedge
  lines(c(xtop, xtop-wtop), c(ytop, ytop))
  lines(rep(xtop, 2), c(ytop, ytop+htop(xtop)))
  lines(rep(xtop, 2)-wtop, c(ytop, ytop+htop(xtop-wtop)))
  # draw drop lines to reactions between TFs
  iIRX3 <- min(which(A$IRX3 > A$OLIG2))
  lines(rep(H2O[iIRX3], 2), c(A$IRX3[iIRX3], ytop+htop(H2O[iIRX3])), lty=2)
  iDBX2 <- min(which(A$DBX2 > A$NKX61))
  lines(rep(H2O[iDBX2], 2), c(A$DBX2[iDBX2], ytop+htop(H2O[iDBX2])), lty=2)
  iDBX1 <- min(which(A$DBX1 > A$NKX62))
  lines(rep(H2O[iDBX1], 2), c(A$DBX1[iDBX1], ytop+htop(H2O[iDBX1])), lty=2)
  # indicate plot variables
  arrows(-2.7, 2, -2.7, 2.5, 0.1)
  text(-2.8, 2.3, "affinity\nvs. Shh", adj=0)
  arrows(-2.7, 2, -2.27, 2, 0.1)
  text(-2.3, 1.8, expression(list(log*italic(f)[O[2]], )), adj=0)
  text(-2.3, 1.6, expression(list(log*italic(a)[H[2]*O])), adj=0)
  # label neural progenitors
  text(-2.37, -1.55, "FP")
  text(-1.6, -1.55, "p3")
  text(-0.53, -1.55, "pMN")
  text(0.2, -1.55, "p2")
  text(0.2, 5.25, "pMN")
  text(-0.47, 5.25, "p2")
  text(-2.2, 5.25, "p1")
  text(-4, 5.25, "p0")
  # label Shh gradient and stages
  text(1.2, -1.2, "Shh\ngradient", adj=0)
  text(1.2, 4.9, "Shh\ngradient", adj=0)
  text(-2.6, -0.6, expression(italic("Stage 1: loading")), adj=0)
  text(-1.5, 4.3, expression(italic("Stage 2: unloading")), adj=0)
} else {
  # add second axis: logfO2
  pu <- par("usr")
  pu[1:2] <- rev(range(O2))
  par(usr=pu)
  axis(3, at=seq(-75, -105, by=-5))
  mtext(expression(log*italic(f)[O[2]]), line=2)
}
# all done!
par(opar)
if(pdf) dev.off()
reset()
