# clocksim
# copyright 2008 joel s. bader joel.bader@jhu.edu
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Lesser General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU Lesser General Public License for more details.
#
#    For a copy of the GNU Lesser General Public License
#    see <http://www.gnu.org/licenses/>.

### clock simulation adapted from
### lsexamp -- example from lsoda source code

rm(list=ls());
require(odesolve);
require(rgl);
require(scatterplot3d);
require(GillespieSSA);

Pause <- function () { 
    cat("Hit <enter> to continue...")
    readline()
    invisible()
}

   ########################################################################
# M.H.Prager Function for a 4D contourplot
# email: mike.prager AT noaa.gov
# This function plots x and y versus two responses, z1 and z2
# Variable z1 is plotted as colored (or grayscale) contour areas with key
# Variable z2 is overlaid as heavy black contours with labels
# R language  April 8, 2005
# Revised considerably: June 29, 2006
# Last revision: October 18, 2006
########################################################################
plot4d <- function(x, y, z1, z2, levs1 = NULL, nlev1 = 8, nlev2 = 8,
   keylab = deparse(substitute(z1)),
   main = paste("Black contours:", deparse(substitute(z2))),
   col.start = 0.0, col.stop = 0.8, col.sat = 0.35,
   use.color = TRUE, label.regions = FALSE,
   draw.grid = FALSE,
   xlab = deparse(substitute(x)),
   ylab = deparse(substitute(y))){
########################################################################
# ARGUMENT DEFINITIONS -- Most have Defaults (see arg list above)
#     x - x vector, dimension nx
#     y - y vector, dimension ny
#     z1 - response matrix 1, dimensions nx, ny
#     z2 - response matrix 2, dimensions nx, ny
#     NOTE: See contour() function help for relationships of x, y, z1 or z2
#     nlev1 - number of contour levels desired for colored contours of z1
#     nlev2 - number of contour levels desired for heavy contours of z2
#     keylab - text for colored-contour key (should be brief)
#     main - text for main title of plot
#     xlab, ylab - labels for x-axis and y-axis, respectively
#     col.start - starting value for rainbow of colors or grayscale
#     col.stop - ending value for rainbow of colors or grayscale
#     col.sat - saturation of colors
#     use.color - TRUE for rainbow, FALSE for grayscale
#     draw.grid - TRUE to overlay reference grid on contours
#     label.regions - TRUE to get numeric labels on filled contours
########################################################################
  if (is.null(levs1)) {
    levs <- pretty(z1, n = nlev1)    # Levels R will use for colored contours
  } else {
    levs <- levs1;
  }
  nlev1 <- length(levs)            # How many breaks are there?
   # Define colors for breaks:
   if (use.color) {
      cols = rainbow(n = nlev1-1, s = col.sat, v = 1, start = col.start,
         end = col.stop)
      } else {
      cols = gray(seq(from = col.start, to = col.stop, length = nlev1 - 1))
      }
   if (is.null(names(x))) {
     xaxislabels <- TRUE;
   } else {
     xaxislabels <- names(x);
   }
   if (is.null(names(y))) {
     yaxislabels <- TRUE;
   } else {
     yaxislabels <- names(y);
   }
   # Plot x-variable, y-variable, and first z-variable
   filled.contour(x, y, z1,
      main = main, font.main = 1, cex.main = 1.0, 
      levels = levs, col = cols, xlab = xlab, ylab = ylab,
      key.title = {title(main = keylab, font.main = 1, cex.main = 1.0)},
      # Rest of plot is done within plot.axes to get scaling right
      plot.axes = {
         axis(side = 1, at=x, labels=xaxislabels)
         axis(side = 2, at=y, labels=yaxislabels)
         ### Add gray contour lines to color plot.
         contour(x, y, z1, add = TRUE, col = "gray40", lwd = 1,
            nlevels = nlev1, levels=levs, drawlabels = label.regions,
            lty = "solid", method = "edge", vfont = c("sans serif", "bold"))
         #### Plot second z-variable as heavy lines:
         contour(x, y, z2, add = TRUE, labcex = 1.1, lwd = 2,
         nlevels = nlev2, vfont = c("serif", "bold"))
         #### Add a light grid:
         if(draw.grid)  {
            grid(col="gray50")
            } else  {
            axis(side = 3, labels = FALSE, tcl = -0.3)
            axis(side = 4, labels = FALSE, tcl = -0.3)
            }

      }  # End of plot.axes
   )     # End of filled.contour call
}        # End of function (love those braces!)
########################################################################


hillfn <- function(x, x0, n) {
  term <- (x/x0)^n;
  ret <- term / (1 + term);
  return(ret);
}

blydot <- function(t, y, p) {
  aactive <- hillfn(y["a"], p["bigk"], p["nhill"]);
  ractive <- hillfn(y["a"], p["bigkr"], p["nhill"]);
  kar <- p["k"] * y["a"] * y["r"];
  cdeg <- p["alphaa"] * y["c"];
  adot <- p["beta0"] + (p["betaa"] - p["beta0"])*aactive -
    kar - p["alphaa"] * y["a"];
  rdot <- p["betar0"] + (p["betar"] - p["betar0"])* ractive - kar - p["alphar"] * y["r"] + cdeg;
  cdot <- kar - cdeg;
  ret <- list(c(adot, rdot, cdot), c(adot=adot, rdot=rdot, cdot=cdot, kar=kar, cdeg=cdeg));
  return(ret);
}

getTauStoch <- function(parms, tf, method) {
  x0 <- c(AP=0, RP=0, CP=0, Dummy=1)
  nu <- matrix( c(1, 1, -1, 0, 0,  0, -1,  0,
                  0, 0,  0, 1, 1, -1, -1,  1,
                  0, 0,  0, 0, 0,  0,  1, -1,
                  0, 0,  0, 0, 0,  0,  0,  0), nrow = 4, byrow=T);
  rates <- c(
             "beta0",
             "(betaa - beta0)*( (AP/bigk)^nhill )/( 1. + (AP/bigk)^nhill)",
             "alphaa * AP",
             "betar0",
             "(betar - betar0)*( (AP/bigkr)^nhill )/( 1. + (AP/bigkr)^nhill)",
             "alphar * RP",
             "k*AP*RP",
             "alphaa * CP"
             );


  simName <- "Gillespie";
  out <- ssa(x0=x0, a=rates, nu=nu, parms=parms, tf=tf, method =method, simName=simName,
             verbose = TRUE, consoleInterval = 1, censusInterval=0)
  return(out)
}

plotTraj <- function(ode = NULL, math = NULL, stoch = NULL, times, logstr="", method) {

  ymax <- max(ode$a, ode$r, ode$c, math$a, math$r, math$c);
  ymin <- min(ode$a, ode$r, ode$c, math$a, math$r, math$c);
  if (logstr == "") {
    ymin <- 0;
  }

  plotStart <- function() {
    plot(times, rep(1, length(times)), typ="n",
         xlab="Time / hr", ylab="Molecules / cell",
         ylim=c(ymin,ymax),log=logstr, cex.axis=1.5, cex.lab=1.5);
  }

  plotLeg <- function(methstr) {
    legend(x="topright", legend=c(methstr,"A","R","C"),
           lty=c(NA,1,1,1), col=c("","green","red","black"), cex=1.25, bg="white");
  }
  
  op <- par(mfrow=c(3,1))

  if (! is.null(math) ) {
    plotStart();
    lines(times, math$a, col="green");
    lines(times, math$r, col="red");
    lines(times, math$c, col="black");
    plotLeg("Analytic");
  }



  # ODE solution for A, R, C
  if (! is.null(ode) ) {
    plotStart();
    lines(ode$t, ode$a, col="green");
    lines(ode$t, ode$r, col="red");
    lines(ode$t, ode$c, col="black");
    plotLeg("ODE");
  }

  if (! is.null(stoch)) {
    plotStart();
    lines(stoch$data[,1], stoch$data[,2], col="green");
    lines(stoch$data[,1], stoch$data[,3], col="red");
    lines(stoch$data[,1], stoch$data[,4], col="black");
    plotLeg(paste("Stochastic"));
  }

  par(op)
  
}



# analytical solution
#CK edit: change times = NULL to times in ()

getTrajMath <- function(params, times=NULL){

  # copy the parameters
  alphaa <- as.numeric(params["alphaa"]);
  beta0 <- as.numeric(params["beta0"]);
  betaa <- as.numeric(params["betaa"]);
  bigk <- as.numeric(params["bigk"]);
  alphar <- as.numeric(params["alphar"]);
  betar0 <- as.numeric(params["betar0"]);
  betar <- as.numeric(params["betar"]);
  bigkr <- as.numeric(params["bigkr"]);
  nhill <- as.numeric(params["nhill"]);
  k <- as.numeric(params["k"]);
  
  ## important constants


##CK edit

#betax <- ((betaa - beta0)/bigk^nhill) - betar/bigkr^nhill; 
betax <- ((betaa - beta0)/bigk^nhill) - (betar-betar0)/bigkr^nhill; 

##CK edit ends
  
amin <- min(alphaa, alphar);
  deltaa <- abs(alphaa - alphar);
  x <- sqrt(beta0 / k);
  
  # tk is (a = r = x) to (a = bigk)
  if (nhill == 1) {
    tk <- log(bigk/x) / (betax - alphaa);
  } else {
 
##CK edit
#tk <- (1./( (nhill - 1) * betaa)) * ( x^(1-nhill) - bigk^(1-nhill) );
tk <- (1./( (nhill - 1) * betax)) * ( x^(1-nhill) - bigk^(1-nhill) );
##CK edit ends

  }

  # tk1 is (a = bigk, going up) to (a = bigk, going back down)
#CK edit: this is actually tauk1, not tk1
  tk1 <- (betaa - beta0 - alphaa * bigk) / (alphaa * betar);

  # tc is (a = bigk, c = cmax) to (a = 0, c = cmax)
#CK edit: this is actually tauC, not tc
  tc <- -alphaa^(-1) * log(1 - alphaa*bigk/(betaa - beta0));

  # tx is (c = cmax) to (r = x)
#CK edit: this is actually taux, not tx
  if (alphaa == alphar) {
    tx1 <- alphar^(-1) * log( (betaa - beta0 - alphaa * bigk) / x );
    tx <- tx1 + alphar^(-1)*log(tx1);
  } else {
    tx <- (1./amin) * log( (betaa - beta0 - alphaa * bigk) / (deltaa * x ));
  }
  ttot <- tk + tk1 + tc + tx;
  t1 <- tk + tk1 + tc;
  t2 <- tx;

  amax <- ((betaa - beta0 - betar)/alphaa) -
    (betar/alphaa)*log( (betaa - beta0 - alphaa * bigk)/betar );
  if (alphar == alphaa) {
    rmax <- ( (betaa - beta0)/alphaa - bigk) / exp(1.);
  } else {
    rmax <- ( (betaa - beta0)/alphaa - bigk) *
      (alphar/alphaa)^(alphar / (alphaa - alphar));
  }
  cmax <- (betaa / alphaa) - bigk;
  
  cnt <- trunc(times / ttot);
  dt <- times - cnt * ttot;

  a1 <- NULL;
  r1 <- NULL;
  c1 <- NULL;
  if (! is.null(times) ) {
    if (nhill == 1) {
      a1 <- ifelse(dt <= tk, x*exp((betax - alphaa)*dt) ,
                   ifelse(dt <= tk + tk1, bigk * exp(-alphaa * (dt - tk))
                          + ((betaa - beta0)/alphaa) * (1-exp(-alphaa*(dt-tk)))
                          - betar * (dt-tk),
                          ifelse(dt <= tk + tk1 + tc,
                                 bigk + ( (betaa - beta0)/alphaa )*
                                 (exp(-alphaa*(dt-tk-tk1)) - 1),
                                 0)));
    } else {
      a1 <- ifelse(dt <= tk, (x^(1-nhill) - (nhill-1)*betax*dt)^(1/(1-nhill)),
                   ifelse(dt <= tk + tk1, bigk * exp(-alphaa * (dt - tk))
                          + ((betaa - beta0)/alphaa) * (1-exp(-alphaa*(dt-tk)))
                          - betar * (dt-tk),
                          ifelse(dt <= tk + tk1 + tc,
                                 bigk + ( (betaa - beta0)/alphaa )*
                                 (exp(-alphaa*(dt-tk-tk1)) - 1),
                                 0)));
    }
    tr0 <- tk + tk1 + tc;
    if (alphaa == alphar) {
      r1 <- ifelse(dt <= tr0, x,
                   (betaa - beta0 - alphaa * bigk) * (dt-tr0) *
                   exp(-alphaa * (dt - tr0)));
    } else {
      r1 <- ifelse(dt <= tr0, x,
                   ( (betaa - beta0 - alphaa * bigk) / (alphaa - alphar) ) *
                   ( exp(-alphar * (dt - tr0)) - exp(-alphaa * (dt - tr0)) ));
    }
    c1 <- ifelse(dt <= tk, beta0 / alphaa,
                 ifelse(dt <= tk + tk1, (beta0/alphaa) + betar * (dt - tk),
                        ifelse(dt <= tk + tk1 + tc, (betaa / alphaa) - bigk,
                               (beta0/alphaa) +
                               ( (betaa - beta0)/alphaa - bigk ) *
                               exp(-alphaa * (dt - tr0)))));
    
  
    a1 <- ifelse(a1 < x, x, a1);
    r1 <- ifelse(r1 < x, x, r1);
  }

  ret = list(tk=tk, tk1=tk1, tc=tc, tx=tx, t1=t1, t2=t2, ttot=ttot,
    amax=amax, rmax=rmax, cmax=cmax,
    a=a1, r=r1, c=c1);
  return(ret);
}

getTau <- function(traj) {
  # assume that the first point is actually at time 0
  sumtau <- vector("numeric", 2);
  ntau <- vector("numeric", 2);
  phase <- 1;
  t0 <- traj$t[1];
  avg <- mean(traj);
  for (i in 2:(length(traj$t)-1)) {
    newphase <- FALSE;
    if (phase == 1) { # condition for end of phase 1 is c = cmax
      newphase <-  (traj$c[i] > avg["c"]) &&
      (traj$c[i] >= traj$c[i-1]) &&
      (traj$c[i] >= traj$c[i+1]) ;
    } else { # condition for end of phase 2 is that A and R are low, A has just crossed R
      newphase <- (traj$r[i-1] < avg["r"]) &&
      ( traj$a[i-1] <= traj$r[i-1] ) &&
      ( traj$a[i] >= traj$r[i] ) &&
      ( traj$a[i] >= traj$a[i-1] );
    }
    if (is.na(newphase)) { newphase <- FALSE; }
    if (newphase) {
      dt <- traj$t[i] - t0;
      sumtau[phase] <- sumtau[phase] + dt;
      ntau[phase] <- ntau[phase] + 1;
      # cat("end phase", phase,"dt",dt,"i",i,"t[i]",traj$t[i],"\n")
      t0 <- traj$t[i];
      phase <- 3 - phase;
    }
  }
  t1 <- Inf;
  t2 <- Inf;
  if (ntau[1] >= 1) { t1 <- sumtau[1] / ntau[1]; }
  if (ntau[2] >= 1) { t2 <- sumtau[2] / ntau[2]; }
  ttot <- t1 + t2;
  ret <- list(t1=t1, t2=t2, ttot = ttot);
  return(ret);
}

# main program
## names makes this easier to read, but may slow down execution.
alphaa <- 1; 
alphar <- .2; 
beta0 <- 5;  
betaa <- 50;
betar <- 10;
betar0 <- 0;
k <- 100;
bigk <- 1;
bigkr <- 2;
nhill <- 2;
small <- 1.e-6;
my.atol <- c(small,  small,  small)

#CK edit: add chooseplot function (3D/4D plots)

chooseplot <- "2D" # 2D 2Dv 3D 4D

#CK edit: add 3D plot code

if ((chooseplot == "2D") || (chooseplot == "2Dv") || (chooseplot == "3D")) {

  cscale = 1;
  br0 = betar0;
  nh = nhill;
  method = "D";
  
  if (chooseplot == "2Dv") {
    cscale = 50;
    br0 = 0.002;
    nh = 1;
    method = "BTL";
  }
  
  params <- c(alphaa=alphaa, alphar=alphar,
              beta0= cscale * beta0, betaa= cscale * betaa,
              betar= cscale * betar, betar0= cscale * br0,
              k=k / cscale,
              bigk=bigk * cscale,
              bigkr=bigkr * cscale, nhill=nh);

  ## get the analytical solution

  taumath <- getTrajMath(params);
  lasttime <- 5 * taumath$ttot;
  deltat = taumath$ttot / 200.;
  times <- seq(0, lasttime, by=deltat);
  
	  ## start with A and R just having crossed, c at baseline
  x <- sqrt(beta0/k);  # value when A and R cross
  y0 <- c(a=x, r=x, c=beta0/alphaa);
  traj <- lsoda(y0, times, blydot, params, rtol=small, atol=my.atol)
  traj <- as.data.frame(traj);
  
  tauode <- getTau(traj);
  
  taumath <- getTrajMath(params, times);		  
  
  taustoch <- getTauStoch(params, lasttime, method)
  
  #plot3d(taumath$a, taumath$r, taumath$c,
  #       col = "red" ,type = "s",size = 0.5, xlab="A", ylab="R", zlab="C") ;
  #points3d(traj$a, traj$r, traj$c, col = "blue");
  #title3d(main = "red = analytical, blue = numerical", pos = c(0,0,0));

  ifpdf <- FALSE;
  if (ifpdf) {
    pdf(file=paste("f-", chooseplot,".pdf", sep=""),
        title=which, onefile=TRUE,width=6, height=8);
  }
  if (chooseplot == "3D") {
    mm <- times < taumath$ttot;
    rbc <- rainbow(sum(mm));
    s3d <- scatterplot3d(taumath$r[mm], taumath$c[mm], taumath$a[mm], type="p",
                         xlab="R", ylab="C", zlab="A", pch=21,
                         color=rbc, angle=40);
    s3d$points3d(taumath$r[mm], taumath$c[mm], taumath$a[mm],
                 pch=21, col=rbc, bg=rbc);
    nn <- times < tauode$ttot;
    rbc1 <- rainbow(sum(nn));
    s3d$points3d(traj$r[nn], traj$c[nn], traj$a[nn], pch=24, col=rbc1, bg=rbc1);
    cexfac = 1.2;

    legend(s3d$xyz.convert(10, 20, 22), pch = c(21, 24), yjust = 0, 
           legend = c("Analytical", "Numerical"), cex = cexfac) ;

    itauk = round(taumath$tk / deltat);
    itauk1 = round(taumath$tk1 / deltat);
    itauc = round(taumath$tc / deltat);
    itau2 = round(taumath$tx / deltat);
    itk1 = itauk + itauk1;
    it1 = round(taumath$t1 / deltat); # should be tk + tk1 + tc
    it2 = trunc(taumath$ttot / deltat);
    text(s3d$xyz.convert(taumath$r[itauk]+2, taumath$c[itauk], taumath$a[itauk]+2), 
         expression(tau[italic(K)]), cex = cexfac,pos=2) ;
    #text(s3d$xyz.convert(taumath$r[itk1], taumath$c[itk1], taumath$a[itk1]), 
    #     expression(tau[italic(K)]+tau[italic(K)*minute]), cex = 1.1) ;
    text(s3d$xyz.convert(taumath$r[it1], taumath$c[it1], taumath$a[it1]), 
         expression(tau[italic(K)]+tau[italic(K)*minute] %~~%
             tau[italic(K)]+tau[italic(K)*minute]+tau[italic(C)] %==% tau[1]),
             cex = cexfac,pos=4) ;
    text(s3d$xyz.convert(taumath$r[it2]+1, taumath$c[it2], taumath$a[it2]+1), 
         expression(tau[1]+tau[2]%==%tau[tot]),cex = cexfac,pos=4) ;
    
    
  } else {
    plotTraj(traj, taumath, taustoch, times, logstr="", method);
    #abline(h=x);
    #abline(h=beta0/(betaa * k / (3 * alphaa)));
  }
  if (ifpdf) {
    dev.off();
  }
  
} else if (chooseplot == "4D"){

  # good: alpha beta smallbeta bigk nhillvsk
  allphase <- c("ttot", "t1", "t2");
  for (which in c("alpha", "beta", "smallbeta", "nhillvsk", "bigk")) {
    if (which != "bigk") { next; }

      dx <- 0.5;
      xlab <- "x lab";
      ylab <- "y lab";


      levs <- NULL;
      if (which == "alpha") {
        vec1 <- 10^seq(-1, .5, by=dx); 
        vec2 <- 10^seq(-1, .5, by=dx);
        xlab <- expression(log10(alpha[A]));
        ylab <- expression(log10(alpha[R]));
        levs <- pretty(seq(0,100,10), n=10);
      } else if (which == "beta") {
        vec1 <- 10^seq(1.3, 2.3, by=dx);    
        vec2 <- 10^seq(0.3, 1.3, by=dx);
        xlab <- expression(log10(beta[A]));
        ylab <- expression(log10(beta[R]));
        levs <- pretty(seq(0,100,10), n=10);
      } else if (which == "bigk") {
        vec1 <- 10^seq(-.7, 0.3, by=dx);  
        vec2 <- 10^seq(0, 1, by=dx); 
        xlab <- expression(log10(K[A]));
        ylab <- expression(log10(K[R]));
        levs <- pretty(seq(0,50,1), n=10);
      } else if (which =="nhillvsk"){
        vec1 <- 10^seq(0, .7, by=dx);
        vec2 <- 10^seq(1.5, 2.5, by=dx);
        xlab <- expression(log10(n[Hill]));
        ylab <- expression(log10(k));
        levs <- pretty(seq(0,50,1), n=10);
      } else if (which =="smallbeta"){
        dx2 <- 2 * dx;
        vec1 <- 10^seq(-.5, 1, by=dx2);
        vec2 <- 10^seq(-4, -2, by=dx2);
        xlab <- expression(log10(beta[a]));
        ylab <- expression(log10(beta[r]));
        levs <- pretty(seq(0,50,1), n=10);
      }
  
      ttmath <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
      t1math <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
      t2math <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
      ttode <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
      t1ode <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
      t2ode <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));

    amath <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
    rmath <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
    cmath <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
    aode <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
    rode <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));
    code <- matrix(data=NA, nrow=length(vec1), ncol=length(vec2));

    
      params <- c(alphaa=alphaa, alphar=alphar,
                  beta0=beta0, betaa=betaa, betar=betar, betar0=betar0,
                  k=k, bigk=bigk, bigkr=bigkr,
                  nhill=nhill);
      
      for (i in 1:length(vec1)) {
        for (j in 1:length(vec2)) {
          if (which == "alpha") {
            params["alphaa"] <- vec1[i];
            params["alphar"] <- vec2[j];
          } else if (which == "beta") {
            params["betaa"] <- vec1[i];
            params["betar"] <- vec2[j];
            params["beta0"] <- 0.1 * vec1[i];
          } else if (which == "bigk") {
            params["bigk"] <- vec1[i];
            params["bigkr"] <- vec2[j];
          } else if (which == "nhillvsk"){
            params["nhill"] <- vec1[i];
            params["k"] <- vec2[j];
          } else if (which == "smallbeta"){
            params["beta0"] <- vec1[i];
            params["betar0"] <- vec2[j];
          }
      
          ## get the analytical period
          taumath <- getTrajMath(params);
          times <- seq(0, 2*taumath$ttot, by=0.05*taumath$ttot);
          
          ## start with A and R just having crossed, c at baseline
          x <- sqrt(beta0/k);  # value when A and R cross
          y0 <- c(a=x, r=x, c=beta0/alphaa);
          traj <- lsoda(y0, times, blydot, params, rtol=small, atol=my.atol)
          traj <- as.data.frame(traj);
          
          tauode <- getTau(traj);
          
          ttmath[i,j] <- taumath$ttot;
          t1math[i,j] <- taumath$t1;
          t2math[i,j] <- taumath$t2;
          ttode[i,j] <- tauode$ttot;
          t1ode[i,j] <- tauode$t1;
          t2ode[i,j] <- tauode$t2;

          amath[i,j] <- taumath$amax;
          rmath[i,j] <- taumath$rmax;
          cmath[i,j] <- taumath$cmax;

          aode[i,j] <- max(traj$a);
          rode[i,j] <- max(traj$r);
          code[i,j] <- max(traj$c);
          
          for (phase in allphase) {
            cat("i", i, "j", j, phase,
                "math", as.numeric(taumath[phase]),
                "ode", as.numeric(tauode[phase]), "\n");
          }
        }
      }


    x <- round(log10(vec1), digits=2);
    y <- round(log10(vec2), digits=2);
    
    ispdf <- FALSE;
    for (prot in c("Activator", "Repressor", "Complex")) {
      if (ispdf) {
        filename <- paste("fig-", prot, ".pdf",sep="");
        pdf(file=filename, title=which, onefile=TRUE,
            width=6.75, height=6
            );
      }
      if (prot == "Activator") {
        zode = aode;
        zmath = amath;
      } else if (prot == "Repressor") {
        zode = rode;
        zmath = rmath;
      } else if (prot == "Complex") {
        zode = code;
        zmath = cmath;
      }
      plevs <- NULL;
      if ((which == "smallbeta") || (which == "nhillvsk")) {
        plevs <- pretty(seq(0,50,1), n=10);
      }
      plot4d(x, y, zode, zmath,
             main=paste("Black contours: Analytic Maximum,", prot),
             keylab="Numeric",
             xlab=xlab,
             ylab=ylab,
             levs1 = plevs
             );
      if (!ispdf) { Pause(); }
      if (ispdf) { dev.off(); }    
    }
    
    for (phase in allphase) {
      next;
      
      if (ispdf) {
        filename <- paste("fig-", which, "-", phase, ".pdf",sep="");
        pdf(file=filename, title=which, onefile=TRUE,
            width=6.75, height=6
            );
      }
    
      taustr <- "";
      if (phase == "ttot") {
        zmath <- ttmath;
        zode <- ttode;
        taustr <- "Total";
      } else if (phase == "t1") {
        zmath <- t1math;
        zode <- t1ode;
        taustr <- "Phase 1";
      } else if (phase == "t2") {
        zmath <- t2math;
        zode <- t2ode;
        taustr <- "Phase 2";
      }
      zode <- ifelse(zode == Inf, NA, zode);
      if (!is.null(levs)) {
        maxval <- max(levs);
        zode <- ifelse(zode < maxval, zode, maxval);
      }
  
      plot4d(x, y, zode, zmath,
             main=paste("Black contours: Analytic Period,", taustr),
             keylab="Numeric",
             xlab=xlab,
             ylab=ylab,
             levs1=levs
             );
      if (!ispdf) { Pause(); }
      if (ispdf) { dev.off(); }
    }
  }
}