## ----style, eval=TRUE, echo=FALSE, results="asis"--------------------------
BiocStyle::latex()

## ----setup, include=FALSE--------------------------------------------------
library(knitr)
opts_chunk$set(fig.path="figPaper/", fig.width=9, fig.height=8, warning=FALSE, 
    out.width="0.5\\textwidth", fig.align="center", message=FALSE, dpi=300)

## ----loadData--------------------------------------------------------------
library(TimerQuant)
library(ggplot2)
library(grid)
library(deSolve)
library(reshape2)
library(dplyr)
data("profileGradients")
data("maturationData")
data("FRETdata")
myTheme <- theme_bw()+theme(title=element_text(size=32), 
    text=element_text(size=24), axis.title.y=element_text(vjust=1.5), 
    panel.grid=element_blank())

## ----fig1b, fig.cap="Figure 1B: Time-dependent model solutions for FP1 and FP2 fluorescence intensities."----
t <- seq(0.001, 1200, by=0.1)
p0 <- 10
TA <- 30
TB <- 180
kA <- log(2)/TA
kB <- log(2)/TB
T1 <- 5
T2 <- 100
m1 <- log(2)/T1
m2 <- log(2)/T2
df <- data.frame(t=t, x1B=x1(p0, m1, kB, t), x2B=x1(p0, m2, kB, t),
    x1A=x1(p0, m1, kA, t), x2A=x1(p0, m2, kA, t))
df <- melt(df, id="t")
df$FP <- df[, "halflife"] <- NA
df[df$variable %in% c("x1B", "x1A"), "FP"] <- "FP1"
df[df$variable %in% c("x2B", "x2A"), "FP"] <- "FP2"
df[df$variable %in% c("x1A", "x2A"), "halflife"] <- paste(TA, "minutes")
df[df$variable %in% c("x1B", "x2B"), "halflife"] <- paste(TB, "minutes")
ggplot(df, aes(x=t, y=value, color=FP, linetype=halflife))+geom_line(size=1)+
    scale_color_manual(values=c("darkgreen", "red"))+
    scale_linetype_manual(values=c("solid", "dashed"))+myTheme+
    scale_x_continuous(breaks=seq(0, 1200, by=200))+
    theme(legend.position="none")+
    labs(list(linetype="half-life", color="fluorophore"))+
    xlab("time (minutes)")+
    ylab("fluorescence intensity (a.u.)")

## ----fig1c, fig.cap="Figure 1C: Time-dependent model solution for the FP2/FP1 fluorescence intensity ratio."----
df <- data.frame(t=t[-1], RatioB=x1(p0, m2, kB, t[-1])/x1(p0, m1, kB, t[-1]), 
    RatioA=x1(p0, m2, kA, t[-1])/x1(p0, m1, kA, t[-1]))
df <- melt(df, id="t")
ggplot(df, aes(x=t, y=value, color=variable, linetype=variable))+
    geom_line(size=1)+scale_color_manual(values=c("blue", "blue"))+
    scale_linetype_manual(values=c("solid", "dashed"))+myTheme+
    scale_x_continuous(breaks=seq(0, 1200, by=200))+
    theme(legend.position="none")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")

## ----fig1d, fig.width=9, fig.height=9, fig.cap="Figure 1D: Steady-state ratios as a function of FP2 maturation time and protein half-life."----
halfLifeSeq <- seq(1, 1000, by=0.1)
tRangeFP1 <- c(1, 50)
tRangeFP2 <- c(10, 500)
colRamp <- 
    colorRampPalette(colors=c('darkgreen','yellow', 'orange', 'red'))(100)
h <- genRatioHeatmap(tRangeFP=tRangeFP2, Tfixed=T1, TA=min(halfLifeSeq), 
    TB=max(halfLifeSeq), channel=2, n=150, ramp=colRamp)
h <- h+geom_hline(yintercept=TA, linetype="dashed", size=1)+
    geom_hline(yintercept=TB, linetype="dashed", size=1)+myTheme+
    annotation_logticks()+
    theme(legend.position="top", legend.key.width=unit(2.5, "cm"))
print(h)

## ----fig1e, fig.width=17, warning=FALSE, message=FALSE, fig.cap="Figure 1E: Results of simulations with an additive error model to investigate the effect of noise on timer signal for varying protein production rates."----
pSeq <- c(0.5, 2, 8)
nRealizations <- 500
sigmaAdd <- 1
T2 <- getSpacedSeq(c(10, 500), n=100)
res <- lapply(pSeq, function(p) lapply(T2, function(Time) 
    simulatedSignalN(T1, T2=Time, TA, TB, sigmaAdd, nRealizations, p=p, E=0)))
dfFP2 <- lapply(seq_along(res), function(i) {
    df2 <- lapply(seq_along(res[[i]]), function(j)
        return(data.frame(p=pSeq[i], Time=T2[j], D=res[[i]][[j]])))
    df2 <- do.call("rbind", df2)
    return(df2)
})
dfFP2 <- do.call("rbind", dfFP2)
dfFP2$FP <- "FP2"
dfFP2s <- dfFP2 %>% group_by(p, Time, FP) %>% 
    summarise(D.mean=mean(D, na.rm=TRUE), D.sd=sd(D, na.rm=TRUE))
dfFP2s$D0 <- simulatedSignal(T1, dfFP2s$Time, TA, TB, sigmaAdd=0, p=dfFP2s$p)
T1 <- getSpacedSeq(c(1, 30), n=100)
T2 <- 100
res <- lapply(pSeq, function(p) lapply(T1, function(Time) 
    simulatedSignalN(T1=Time, T2, TA, TB, sigmaAdd, nRealizations, p=p, E=0)))
dfFP1 <- lapply(seq_along(res), function(i) {
    df2 <- lapply(seq_along(res[[i]]), function(j)
        return(data.frame(p=pSeq[i], Time=T1[j], D=res[[i]][[j]])))
    df2 <- do.call("rbind", df2)
    return(df2)
})
dfFP1 <- do.call("rbind", dfFP1)
dfFP1$FP <- "FP1"
dfFP1s <- dfFP1 %>% group_by(p, Time, FP) %>% 
    summarise(D.mean=mean(D, na.rm=TRUE), D.sd=sd(D, na.rm=TRUE))
dfFP1s$D0 <- simulatedSignal(T1=dfFP1s$Time, T2, TA, TB, sigmaAdd=0, p=dfFP1s$p)
df <- bind_rows(dfFP1s, dfFP2s)
df$p <- paste("\np =", df$p, "molecules/minute\n")
df$FPline <- df$FP
df$FPline <- paste0(df$FP, "line")
ggplot(df, aes(Time, D.mean, colour=FP))+geom_point()+myTheme+
    xlab("FP maturation time (minutes)")+ylab(expression("timer signal"~S))+
    scale_color_manual(values=c("FP1"="darkgreen", "FP2"="red", 
        "FP1line"="black", "FP2line"="black"))+
    scale_x_log10(breaks=getBreaks10(range(df$Time)))+
    geom_errorbar(aes(ymin=D.mean-D.sd, ymax=D.mean+D.sd))+
    geom_line(aes(Time, D0, colour=FPline), data=df)+
    facet_wrap(~p)+
    theme(legend.position="none", strip.text=element_text(size=32, lineheight=0.35))+
    annotation_logticks(sides="b")
T1 <- 5; T2 <- 100

## ----figS2a, fig.width=17, fig.height=12, warning=FALSE, message=FALSE, fig.cap="Figure S2A: Results of simulations with an additive error model to investigate the effect of noise on timer signal for varying levels of FRET."----
ESeq <- c(0, 0.25, 0.5, 0.75, 1)
p <- 2
nRealizations <- 500
sigmaAdd <- 1
T2 <- getSpacedSeq(c(10, 500), n=100)
res <- lapply(ESeq, function(E) lapply(T2, function(Time) 
    simulatedSignalN(T1, T2=Time, TA, TB, sigmaAdd, nRealizations, p=p, E=E)))
dfFP2 <- lapply(seq_along(res), function(i) {
    df2 <- lapply(seq_along(res[[i]]), function(j)
        return(data.frame(E=ESeq[i], Time=T2[j], D=res[[i]][[j]])))
    df2 <- do.call("rbind", df2)
    return(df2)
})
dfFP2 <- do.call("rbind", dfFP2)
dfFP2$FP <- "FP2"
dfFP2s <- dfFP2 %>% group_by(E, Time, FP) %>% 
    summarise(D.mean=mean(D, na.rm=TRUE), D.sd=sd(D, na.rm=TRUE))
dfFP2s$D0 <- simulatedSignal(T1, dfFP2s$Time, TA, TB, sigmaAdd=0, p=p, 
    E=dfFP2s$E)
T1 <- getSpacedSeq(c(1, 30), n=100)
T2 <- 100
res <- lapply(ESeq, function(E) lapply(T1, function(Time) 
    simulatedSignalN(T1=Time, T2, TA, TB, sigmaAdd, nRealizations, p=p, E=E)))
dfFP1 <- lapply(seq_along(res), function(i) {
    df2 <- lapply(seq_along(res[[i]]), function(j)
        return(data.frame(E=ESeq[i], Time=T1[j], D=res[[i]][[j]])))
    df2 <- do.call("rbind", df2)
    return(df2)
})
dfFP1 <- do.call("rbind", dfFP1)
dfFP1$FP <- "FP1"
dfFP1s <- dfFP1 %>% group_by(E, Time, FP) %>% 
    summarise(D.mean=mean(D, na.rm=TRUE), D.sd=sd(D, na.rm=TRUE))
dfFP1s$D0 <- simulatedSignal(T1=dfFP1s$Time, T2, TA, TB, sigmaAdd=0, E=dfFP1s$E,
    p=p)
dfFRET <- bind_rows(dfFP1s, dfFP2s)
dfFRET$E <- paste("\nFRET efficiency E =", dfFRET$E, "\n")
dfFRET$FPline <- dfFRET$FP
dfFRET$FPline <- paste0(dfFRET$FP, "line")
ggplot(dfFRET, aes(Time, D.mean, colour=FP))+geom_point()+myTheme+
    xlab("FP maturation time (minutes)")+ylab(expression("timer signal"~S))+
    scale_color_manual(values=c("FP1"="darkgreen", "FP2"="red", 
        "FP1line"="black", "FP2line"="black"))+
    scale_x_log10(breaks=getBreaks10(range(dfFRET$Time)))+
    geom_errorbar(aes(ymin=D.mean-D.sd, ymax=D.mean+D.sd))+
    geom_line(aes(Time, D0, colour=FPline), data=dfFRET)+
    facet_wrap(~E, nrow=2)+
    theme(legend.position="none", strip.text=element_text(size=32, 
        lineheight=0.35))+
    annotation_logticks(sides="b")
T1 <- 5; T2 <- 100

## ----fig1f, fig.cap="Figure 1F: Coefficient of variation as a function of FP2 maturation time for different protein production rates."----
dfs <- filter(df, FP == "FP2")
dfs$CV <- dfs$D.sd/dfs$D.mean

dfFit <- dfs %>% group_by(p, FP) %>% do(fitCV(.))
ggplot(dfs, aes(Time, D.sd/D.mean, color=p))+geom_point()+myTheme+
    scale_x_log10(breaks=getBreaks10(range(dfs$Time)))+
    scale_y_log10(breaks=getBreaks10(range(dfs$CV)))+
    scale_colour_manual(values=c("#999999", "#009E73", "#CC79A7"))+
    xlab("FP2 maturation time (minutes)")+
    ylab(expression("coefficient of variation"~sigma[S]~"/"~mu[S]))+
    geom_line(aes(Time, CV), size=1.5, data=dfFit)+
    geom_vline(aes(xintercept=FP2optimumTime, color=p), data=dfFit, 
        linetype="dashed")+
    theme(legend.position="none")+
    annotation_logticks()

## ----figS2b, fig.cap="Figure S2B: Coefficient of variation as a function of FP2 maturation time for different FRET efficencies."----
dfs <- filter(dfFRET, FP == "FP2")
dfs$CV <- dfs$D.sd/dfs$D.mean

myCol <- colorRampPalette(c("#999999", "#009E73", "#CC79A7"))(5)
dfFit <- dfs %>% group_by(E, FP) %>% do(fitCV(.))
ggplot(dfs, aes(Time, D.sd/D.mean, color=E))+geom_point()+myTheme+
    scale_x_log10(breaks=getBreaks10(range(dfs$Time)))+
    scale_y_log10(breaks=getBreaks10(range(dfs$CV)))+
    scale_colour_manual(values=myCol)+
    xlab("FP2 maturation time (minutes)")+
    ylab(expression("coefficient of variation"~sigma[S]~"/"~mu[S]))+
    geom_line(aes(Time, CV), size=1.5, data=dfFit)+
    geom_vline(aes(xintercept=FP2optimumTime, color=E), data=dfFit, 
        linetype="dashed")+
    theme(legend.position="none")+
    annotation_logticks()

## ----fig2b, fig.cap="Figure 2B: Comparing the timer signal profiles of three different timers in the zebrafish posterior lateral line primordium."----
myCol <- c(tdTom="orange", TagRFP="darkred", mKate2="purple")
A <- profileGradients
Ahat <- apply(A, c(1, 2), function(x) x/mean(x[1:6]))
Ahat <- aperm(Ahat, c(2, 3, 1))
Ahat <- log2(Ahat)
plotPrimordiumProfile(Ahat["mKate2", , ], ylim=c(-0.3, 1.3), xlim=c(-200, 0), 
    ylab="timer signal", col=myCol["mKate2"], lwd=3, lty=3, 
    cex.axis=1.5, cex.lab=2.5, alpha=0.1)
plotPrimordiumProfile(Ahat["TagRFP", , ], add=TRUE, lty=2, col=myCol["TagRFP"], 
    lwd=3, alpha=0.1)
plotPrimordiumProfile(Ahat["tdTom", , ], add=TRUE, lty=1, col=myCol["tdTom"], 
    lwd=3, alpha=0.1)
abline(v=0, lty=2)
abline(v=-25, lty=2)
nSamples <- c(tdTom=34, TagRFP=40, mKate2=52)
myLegend <- paste0(names(nSamples), "-sfGFP (n=", nSamples, ")")
legend(x=-100, y=1.2, legend=myLegend, lty=1:3, lwd=3, cex=1.5, col=myCol)

## ----figS1Filtering--------------------------------------------------------
A <- maturationData
A[, "meanGFP", 4, 3, "mKate2"] <- NA # jump in signal in gfp
A[, "meanGFP", 2, 2, "TagRFP"] <- NA # jump in signal in gfp
A[, "meanGFP", 1, 4, "tdTom"] <- NA # jump in gfp
A[, "meanRFP", 1:2, 1:4, "TagRFP"] <- NA

## ----figS1Preprocessing----------------------------------------------------
A <- A[as.integer(dimnames(A)$t) <= 800, c("meanGFP", "meanRFP"), , , ] 
A[as.integer(dimnames(A)$t) > 500, "meanGFP", , , ] <- NA
indT <- which(dimnames(A)$t == "500")

myNorm <- function(x, indT) {
    x <- x-min(x, na.rm=TRUE)
    x[x < 0] <- NA
    x <- x/x[indT]
    return(x)
}

Anorm <- apply(A, c(2, 3, 4, 5), myNorm, indT)
dimnames(Anorm) <- dimnames(A)

## ----figS1, fig.width=18, out.width="\\textwidth", fig.cap="Figure S1: Comparing the maturation rates of three different RFPs."----
AnormSummarizeViews <- apply(Anorm, c(1, 2, 3, 5), mean, na.rm=TRUE)
AnormSummarizeSamples <- apply(AnormSummarizeViews, c(1, 2, 4), mean, 
    na.rm=TRUE)
Amelt <- melt(AnormSummarizeSamples, id="t")
Amelt$tFTs <- as.factor(paste0(Amelt$tFTs, "-sfGFP"))
o <- match(levels(Amelt$tFT), paste0(names(myCol), "-sfGFP"))
Amelt$tFTs <- factor(Amelt$tFTs, levels=levels(Amelt$tFTs)[o])
ggplot(na.omit(Amelt), aes(x=t, y=value, color=tFTs))+geom_line(size=2)+
    facet_wrap(~data, scales="free_x")+
    scale_color_manual(values=as.vector(myCol))+
    geom_vline(xintercept=500, linetype="dashed")+
    xlab("time (minutes)")+ylab("normalized fluorescence intensity")+myTheme

## ----fig2c, fig.cap="Figure 2C: FRET efficiency measurements for tdTom-sfGFP and TagRFP-sfGFP."----
FRET <- FRETdata
myColReduced <- myCol[names(myCol) %in% FRET$tFT]
FRET$tFT <- paste0(FRET$tFT, "-sfGFP")
FRET$tFT <- as.factor(FRET$tFT)
o <- match(levels(FRET$tFT), paste0(names(myCol), "-sfGFP"))
FRET$tFT <- factor(FRET$tFT, levels=levels(FRET$tFT)[o])
ggplot(FRET, aes(tFT, FRET, fill="white"))+
    geom_boxplot(outlier.size=0, fill="white")+
    geom_point(aes(x=tFT, y=FRET, colour=tFT, size=4), position="jitter")+
    scale_color_manual(values=as.vector(myColReduced))+xlab("")+myTheme+
    ylab("FRET efficiency")+theme(legend.position="none")+
    theme(axis.text.x=element_text(size=24))
FRETs <- tapply(FRET$FRET, FRET$tFT, median)
print(FRETs)

## ----fig2d, fig.cap="Figure 2D: Model shows that the addition of FRET can cause a reordering of profile slopes."----
FPestimate <- c(mKate2=15, tdTom=80, TagRFP=100)
tFTs <- names(FPestimate)
Rhat <- sapply(tFTs, function(ch) median(Ahat[ch, , "200"], na.rm=TRUE))
Tfront <- 60; Tback <- 5*Tfront
Tseq <- seq(Tfront, Tback, length=100)
T1 <- 6
df <- data.frame(
    halfLife=Tseq,
    tdTomNoFret=signal(T1=T1, T2=FPestimate["tdTom"], TA=Tfront, TB=Tseq, E=0),
    tdTomFret=signal(T1=T1, T2=FPestimate["tdTom"], TA=Tfront, TB=Tseq, 
        E=FRETs["tdTom-sfGFP"]),
    TagRFPNoFret=signal(T1=T1, T2=FPestimate["TagRFP"], TA=Tfront, TB=Tseq, 
        E=0),
    TagRFPFret=signal(T1=T1, T2=FPestimate["TagRFP"], TA=Tfront, TB=Tseq, 
        E=FRETs["TagRFP-sfGFP"]))
df <- melt(df, id="halfLife")
df$FRET <- !grepl(x=as.character(df$variable), pattern="NoFret")
df$FRET <- factor(df$FRET, levels=c("TRUE", "FALSE"))
df$tFT[grepl(x=as.character(df$variable), pattern="mKate2")] <- "mKate2-sfGFP"
df$tFT[grepl(x=as.character(df$variable), pattern="tdTom")] <- "tdTom-sfGFP"
df$tFT[grepl(x=as.character(df$variable), pattern="TagRFP")] <- "TagRFP-sfGFP"
df$tFT <- factor(df$tFT, levels=paste0(names(myCol), "-sfGFP"))
ggplot(df, aes(x=halfLife, y=value, color=tFT, linetype=FRET))+
    geom_line(size=1)+
    scale_color_manual(values=as.vector(myColReduced), 
        guide=guide_legend(title="timer"))+
    scale_linetype_manual(values=c("solid", "dashed"))+
    xlab("simulated protein half-life (minutes)")+
    ylab(expression("simulated timer signal"))+
    geom_vline(xintercept=Tfront, linetype="dotted")+
    scale_x_reverse()+myTheme+
    theme(legend.position=c(0.77, 0.85), legend.key.width=unit(2, "cm"), 
        legend.box.just="left")

## ----figS3a, fig.cap="Figure S4A: Quantification of the time to reach steady-state."----
t <- seq(0.001, 1000, by=0.1)
x1ss0 <- x1ss(p0, m2, kB, f=1)
tss0 <- tss(m2, kB)
df <- data.frame(t=t, x1=x1(p0, m2, kB, t))
ggplot(df, aes(t, x1))+geom_line(col="red", size=1)+xlab("time (minutes)")+
    ylab("FP2 fluorescence intensity (a.u.)")+
    geom_hline(yintercept=x1ss0)+
    geom_abline(intercept=TimerQuant:::inflectionOffset(p0, m2, kB, 0), 
        slope=TimerQuant:::inflectionSlope(p0, m2, kB, 0))+
    geom_vline(xintercept=tss0, linetype="dotted", size=2)+
    geom_point(data=NULL, aes(x=tss0, y=x1ss0), color="blue", size=4)+myTheme

## ----figS3b, fig.width=10, fig.cap="Figure S4B: Time to reach steady-state."----
tRange <- c(10, 100)
colRamp <- rainbow(120)[1:100]
h <- genTimeSteadyStateHeatmap(tRange, tRange, n=150, ramp=colRamp)+myTheme+
    annotation_logticks()
print(h)

## ----set up model----------------------------------------------------------
t <- seq(0, 600, length=1000)
t0 <- min(t); tf <- max(t)
p0 <- 10; k0 <- log(2)/60
k1 <- log(2)/30
m1 <- log(2)/T1; m2 <- log(2)/T2
x01 <- c(X1=x0ss(p0, m1, k0), X2=x1ss(p0, m1, k0))
x02 <- c(X1=x0ss(p0, m2, k0), X2=x1ss(p0, m2, k0))

## ----model functions, echo=FALSE-------------------------------------------
rFun <- function(type, r0, tf, slopePrefactor=0.0015, 
    stepPositionPrefactor=0.1) {
    g <- switch(as.character(type), constant=function(t) r0, 
        burst=stepfun(c(tf/10, tf/10+tf/20), c(r0, r0+2*r0, r0)),
        linearIncrease=function(t) r0+slopePrefactor*r0*t,
        linearDecrease=function(t) r0-slopePrefactor*r0*t,
        stepUp=stepfun(tf*stepPositionPrefactor, c(r0, r0+r0*0.5)),
        stepDown=stepfun(tf*stepPositionPrefactor, c(r0, r0-r0*0.5)))
    return(g)
}

solveModel <- function(x01, x02, tseq, m1, m2, typeProd="constant", 
    typeDeg="constant", p0, k0, stepPositionPrefactorProd=0.1, 
    stepPositionPrefactorDeg=0.1, E=0) {
    p <- rFun(typeProd, r0=p0, tf=max(tseq), 
        stepPositionPrefactor=stepPositionPrefactorProd)
    k <- rFun(typeDeg, r0=k0, tf=max(tseq),
        stepPositionPrefactor=stepPositionPrefactorDeg)
    eqs <- function(t, state, parameters) {
        with(as.list(c(state, parameters)), list(c(dX1=p(t)-m*X1-k(t)*X1, 
            dX2=m*X1-k(t)*X2)))
    }
    fp1 <- ode(y=x01, times=tseq, func=eqs, parms=c(p=p, m=m1, k=k))
    fp2 <- ode(y=x02, times=tseq, func=eqs, parms=c(p=p, m=m2, k=k))
    df <- data.frame(time=fp1[, 1], FP1=fp1[, 3], FP2=fp2[, 3], 
        B=fp2[, 3]/(fp2[, 2]+fp2[, 3]))
    df$FP1 <- df$FP1*(1-df$B*E)
    df$Ratio <- df$FP2/df$FP1
    df$typeProd <- factor(typeProd)
    df$typeDeg <- factor(typeDeg)
    return(df)
}

## ----fig3a, fig.width=18, fig.cap="Figure 3A: Timer readouts for simulations where production and degradation are changing over time, but adding or removing proteins from the system at comparable rates."----
myBreaks <- seq(0, 600, by=120)
dfp <- data.frame(t=t,
    linearIncrease=rFun("linearIncrease", r0=p0, tf=tf)(t),
    linearDecrease=rFun("linearDecrease", r0=p0, tf=tf)(t))
types <- colnames(dfp)[-1]
dfp <- melt(dfp, id="t")
gp <- ggplot(dfp, aes(t, value))+geom_line(size=1)+
    facet_wrap(~variable, ncol=1)+
    xlab("time (minutes)")+ylab("production rate (molecules per minute)")+
    scale_x_continuous(breaks=myBreaks)+myTheme
dfk <- data.frame(t=t,
    linearIncrease=rFun("linearIncrease", r0=k0, tf=tf)(t),
    linearDecrease=rFun("linearDecrease", r0=k0, tf=tf)(t))
dfk <- melt(dfk, id="t")
gk <- ggplot(dfk, aes(t, value))+geom_line(size=1)+
    facet_wrap(~variable, ncol=1)+xlab("time (minutes)")+
    ylab(expression(paste("degradation rate (minutes"^{-1}, ")")))+
    scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd=n, typeDeg=n, p0=p0, k0=k0))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)

reorderFactors <- function(x, channel="uid", ordering) {
    x[, channel] <- as.factor(x[, channel])
    o <- match(ordering, levels(x[, channel]))
    x[, channel] <- factor(x[, channel], levels(x[, channel])[o])
    return(x)
}

df <- reorderFactors(df, "type", types)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+
    scale_x_continuous(breaks=myBreaks)+
    myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 4)))
print(gp, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(gk, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=3))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=4))

## ----fig3b, fig.width=14, fig.cap="Figure 3B: The effect of rapidly changing production dynamics on timer readouts."----
dfp <- data.frame(t=t,
    burst=rFun("burst", r0=p0, tf=tf)(t),
    stepUp=rFun("stepUp", r0=p0, tf=tf)(t))
types <- colnames(dfp)[-1]
dfp <- melt(dfp, id="t")
gp <- ggplot(dfp, aes(t, value))+geom_line(size=1)+
    facet_wrap(~variable, ncol=1)+xlab("time (minutes)")+
    ylab("production rate (molecules per minute)")+
    scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd=n, typeDeg="constant", p0=p0, k0=k0))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+
    scale_x_continuous(breaks=myBreaks)+
    myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 3)))
print(gp, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=3))

## ----fig3c, fig.width=14, fig.height=8, fig.cap="Figure 3C: The effect of rapidly changing degradation dynamics on timer readouts."----
dfk <- data.frame(t=t, 
    stepDown=rFun("stepDown", r0=k0, tf=tf)(t),
    stepUp=rFun("stepUp", r0=k0, tf=tf)(t))
types <- colnames(dfk)[-1]
dfk <- melt(dfk, id="t")
gk <- ggplot(dfk, aes(t, value))+geom_line(size=1)+xlab("time (minutes)")+
    ylab(expression(paste("degradation rate (minutes"^{-1}, ")")))+
    facet_wrap(~variable, ncol=1)+scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd="constant", typeDeg=n, p0=p0, k0=k0))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    xlab("time (minutes)")+
    facet_wrap(~typeDeg, ncol=1, scales="fixed")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~typeDeg, ncol=1, scale="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+scale_x_continuous(breaks=myBreaks)+myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 3)))
print(gk, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=3))

## ----figS4a, fig.width=18, fig.cap="Figure S4A: Timer readouts for simulations with FRET where production and degradation are changing over time, but adding or removing proteins from the system at comparable rates."----
E <- 0.5
myBreaks <- seq(0, 600, by=120)
dfp <- data.frame(t=t,
    linearIncrease=rFun("linearIncrease", r0=p0, tf=tf)(t),
    linearDecrease=rFun("linearDecrease", r0=p0, tf=tf)(t))
types <- colnames(dfp)[-1]
dfp <- melt(dfp, id="t")
gp <- ggplot(dfp, aes(t, value))+geom_line(size=1)+facet_wrap(~variable, ncol=1)+
    xlab("time (minutes)")+ylab("production rate (molecules per minute)")+
    scale_x_continuous(breaks=myBreaks)+myTheme
dfk <- data.frame(t=t,
    linearIncrease=rFun("linearIncrease", r0=k0, tf=tf)(t),
    linearDecrease=rFun("linearDecrease", r0=k0, tf=tf)(t))
dfk <- melt(dfk, id="t")
gk <- ggplot(dfk, aes(t, value))+geom_line(size=1)+
    facet_wrap(~variable, ncol=1)+xlab("time (minutes)")+
    ylab(expression(paste("degradation rate (minutes"^{-1}, ")")))+
    scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd=n, typeDeg=n, p0=p0, k0=k0, E=E))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)

reorderFactors <- function(x, channel="uid", ordering) {
    x[, channel] <- as.factor(x[, channel])
    o <- match(ordering, levels(x[, channel]))
    x[, channel] <- factor(x[, channel], levels(x[, channel])[o])
    return(x)
}

df <- reorderFactors(df, "type", types)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+
    scale_x_continuous(breaks=myBreaks)+
    myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 4)))
print(gp, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(gk, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=3))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=4))

## ----figS4b, fig.width=14, fig.cap="Figure S4B: The effect of rapidly changing production dynamics on timer readouts when FRET is present."----
dfp <- data.frame(t=t,
    burst=rFun("burst", r0=p0, tf=tf)(t),
    stepUp=rFun("stepUp", r0=p0, tf=tf)(t))
types <- colnames(dfp)[-1]
dfp <- melt(dfp, id="t")
gp <- ggplot(dfp, aes(t, value))+geom_line(size=1)+
    facet_wrap(~variable, ncol=1)+
    xlab("time (minutes)")+ylab("production rate (molecules per minute)")+
    scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd=n, typeDeg="constant", p0=p0, k0=k0, E=E))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~type, ncol=1, scales="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+
    scale_x_continuous(breaks=myBreaks)+
    myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 3)))
print(gp, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=3))

## ----figS4c, fig.width=14, fig.height=8, fig.cap="Figure S4C: The effect of rapidly changing degradation dynamics on timer readouts when FRET is present."----
dfk <- data.frame(t=t, 
    stepDown=rFun("stepDown", r0=k0, tf=tf)(t),
    stepUp=rFun("stepUp", r0=k0, tf=tf)(t))
types <- colnames(dfk)[-1]
dfk <- melt(dfk, id="t")
gk <- ggplot(dfk, aes(t, value))+geom_line(size=1)+xlab("time (minutes)")+
    ylab(expression(paste("degradation rate (minutes"^{-1}, ")")))+
    facet_wrap(~variable, ncol=1)+scale_x_continuous(breaks=myBreaks)+myTheme
df <- lapply(types, function(n) solveModel(x01, x02, t, m1=m1, m2=m2, 
    typeProd="constant", typeDeg=n, p0=p0, k0=k0, E=E))
for (i in seq_along(df)) df[[i]]$type <- types[i]
df <- do.call("rbind", df)
df <- na.omit(df)
df2 <- melt(df, id=c("time", "typeProd", "typeDeg", "type"))
df2 <- filter(df2, variable %in% c("FP1", "FP2"))
g2 <- ggplot(df2, aes(time, value, color=variable))+geom_line(size=1)+
    xlab("time (minutes)")+
    facet_wrap(~typeDeg, ncol=1, scales="fixed")+
    scale_x_continuous(breaks=myBreaks)+
    scale_color_manual(values=c("darkgreen", "red"))+
    ylab("FP1, FP2 fluorescence intensity (a.u.)")+myTheme+
    theme(legend.position="none")
g3 <- ggplot(df, aes_string("time", "Ratio"))+geom_line(color="blue", size=1)+
    facet_wrap(~typeDeg, ncol=1, scale="fixed")+xlab("time (minutes)")+
    ylab("FP2/FP1 intensity ratio")+scale_x_continuous(breaks=myBreaks)+myTheme
grid.newpage()
pushViewport(viewport(layout=grid.layout(1, 3)))
print(gk, vp=viewport(layout.pos.row=1, layout.pos.col=1))
print(g2, vp=viewport(layout.pos.row=1, layout.pos.col=2))
print(g3, vp=viewport(layout.pos.row=1, layout.pos.col=3))