.packageName <- "sjemea"
## basenamepy.R --- Implementation of python's basename function.
## Author: Stephen J Eglen
## Copyright: GPL

basenamepy <- function (f) {
  ## Separate file name F into dir, base, and extn.
  dir <- dirname(f)
  file <- basename(f)

  ## Within file, find the last period (some files, such as a.b.R,
  ## have multiple periods.)
  
  periods <- gregexpr("\\.", file)
  last.periods <- sapply(periods, function(x) { max(x)})

  ## Negative values of last.periods indicates that there is no period
  ## in the filename.
  if ( any (neg <- which(last.periods < 0)) )
    last.periods[neg] <- sapply(file, nchar)[neg] + 1
  
  base <- substring(file, first=1, last=last.periods-1)
  extn <- substring(file, first=last.periods)

  list(dir=dir, base=base, extn=extn)
}

## some test functions.
if (FALSE) {
  basenamepy( c("/some/long/dir/cat.py", "/other/dir/apple.b.py"))
  
  filenames <-  c("/some/long/dir/cat.py", "/some/f/d/noextn", "simple.R",
                  "notmuch", "/home/dir/", "/other/dir/apple.b.py")
  r <- basenamepy(filenames)
  cbind(filenames, r$dir, r$base, r$extn)
}
## Compute the correlation index, as defined by Meister et al (1991).
## Author: Stephen J Eglen
## Copyright: GPL
## Sun 04 Mar 2007

corr.index <- function(s, distance.breaks, dt=0.05) {
  ## Make a correlation index object.
  dists = make.distances(s$layout$pos)
  dists.bins = bin.distances(dists, distance.breaks)

  spikes = s$spikes
  if (length(spikes) > 1) {
    corr.indexes = make.corr.indexes(spikes, dt)
    corr.id = cbind(my.upper(dists), my.upper(corr.indexes))
    corr.id.means = corr.get.means(corr.id)
  } else {
    corr.indexes = NA
    corr.id = NA
    corr.id.means = NA
  }

  ## distance.breaks.strings used only by Mutual Information Code?
  distance.breaks.strings =
    levels(cut(0, distance.breaks, right=FALSE, include.lowest=TRUE))

  res = list(dists=dists, dists.bins = dists.bins,
    corr.indexes = corr.indexes,
    dt = dt,
    corr.id = corr.id,
    corr.id.means = corr.id.means,
    distance.breaks=distance.breaks,
    distance.breaks.strings=distance.breaks.strings)

  res
}

make.distances <- function(posns) {
  ## POSNS should be a (N,2) array.  Returns a NxN upper triangular
  ## array of the distances between all pairs of cells.

  ## Currently store distances to the nearest micron, so that it makes
  ## the job of binning distances easier when computing the mean of
  ## correlation index for each "distance".  In Figure 9 of the
  ## Meister 1991 paper, distances are binned into 20um bins to get
  ## round this problem.

  n <- dim(posns)[1]
  dists <- array(0, dim=c(n,n))
  for ( a in 1:n-1)
    for (b in (a+1):n) {
      delta <- posns[a,] - posns[b,]
      dists[a,b] <- round(sqrt( sum(delta**2)))
    }

  dists
}

bin.distances <- function(dists, breaks) {
  ## DISTS is a upper NxN array.
  ## breaks is a vector of breakpoints.
  ## Return an array of the same size where each distance value is
  ## given a corresponding bin number.

  ## e.g.
  ## dists <- matrix( c(0,0,0, 400,0,0, 80, 1000, 0), nrow=3)
  ## jay.bin.distances(dists)
  ## This binning procedure can then be checked by comparing the
  ## distances and their bins:
  ## plot(my.upper(s$dists.bins), my.upper(s$dists))
  ## boxplot(my.upper(s$dists)~ my.upper(s$dists.bins))
  
  distances <- my.upper(dists)
  ## These breaks are hardcoded.

  ##data <- c(0, 100, 700, 900, 400)

  ## Make each bin [low, high) with exception that highest bin is
  ## [low,high]. Labels is false so that we just return numeric count
  ## of bin, rather than a factor.
  bins <- cut(distances, breaks, right=FALSE,
              include.lowest=TRUE, labels=FALSE)
  invalid <- is.na(bins)
  if (any(invalid))
    stop(paste("distances not binned:",
                  paste(distances[which(invalid)],collapse=" ")))
  n <- dim(dists)[1]
  res <- matrix(0, nrow=n, ncol=n)
  res[which(upper.tri(res))] <- bins
  
  res
}


plot.corr.index <- function(s, identify=FALSE,
                            main=NULL,
                            dot.col='red',
                            show.fit=TRUE, show.ci=FALSE,
                            ...) {
  ## Plot the correlation indices as a function of distance.
  ## If identify is TRUE, we can locate cell pairs on the plot using
  ## left mouse button.

  ## Use 'log=y' as one of the extra args if the y-axis should be
  ## drawn on a log scale.
  ## DOT.COL: colour of each dot.
  ## If SHOW.FIT is true, draw the expoential fit.
  ## If SHOW.CI is true, draw the confidence intervals estimated every
  ## 100 um or so.
  
  
  ##dists = s$corr$dists[which(upper.tri(s$corr$dists))]
  ##corrs = s$corr$corr.indexes[which(upper.tri(s$corr$corr.indexes))]
  dists = my.upper(s$corr$dists)
  corrs = my.upper(s$corr$corr.indexes)
  if (is.null(main)) {
    main = paste(basename(s$file), "dt:", s$corr$dt)
  }
  
  xlabel = expression(paste("distance (", mu, "m)"))

  plot.default(dists, corrs, xlab=xlabel, ##log=log,
               ylab="correlation index", bty="n",
               main=main, col=dot.col,
               ...)

  if (identify) {
    labels1 <- outer(seq(1, s$NCells), seq(1,s$NCells), FUN="paste")
    labs <- labels1[which(upper.tri(labels1))]
    identify(dists, corrs, labels=labs)
  }

  if (show.ci) 
    plotCI(s$corr$corr.id.means[,1], s$corr$corr.id.means[,2],
           s$corr$corr.id.means[,3],
           xlab="distance", ylab="correlation index", 
           pch=19, add=TRUE)
  if (show.fit) 
    corr.do.fit(s$corr$corr.id,plot=TRUE)
}

write.corr.indexes <- function(s, file=NULL) {
  ## Write out the correlation index values to a CSV file for
  ## further processing.
  ncells = s$NCells
  op = matrix(0, nrow= (ncells*(ncells-1)/2), ncol=4)

  colnames(op) = c("unit.i", "unit.j", "distance (um)", "corr index")
  d = s$corr$dists                      #distance matrix
  c = s$corr$corr.indexes               #correlation matrix
  n=1;
  for (j in 1:(ncells-1)) {
    for (i in (j+1):ncells) {
      op[n,1] = j;
      op[n,2] = i;
      op[n,3] = d[j,i];
      op[n,4] = c[j,i];
      n=n+1
    }
  }

  if (is.null(file)) {
    file = paste(basenamepy(s$file)[2], "_corrs.csv", sep='')
    cat(sprintf("Writing correlations to %s\n", file))
  }
  write.csv(op, file=file, row.names=FALSE)
  ## Return the file as well in case we want it.
  invisible(op)
}

plot.corr.index.fit <- function(s, ...) {
  ### Show the correlation indexes and then the fit.
  plot.corr.index(s, identify=FALSE,col="red", log="")
  plotCI(s$corr.id.means[,1], s$corr.id.means[,2], s$corr.id.means[,3],
         xlab="distance", ylab="correlation index", 
         pch=19, add=TRUE)
  corr.do.fit(s$corr.id,plot=TRUE)
}


make.corr.indexes <- function(spikes, dt) {
  ## Return the correlation index values for each pair of spikes.
  ## The matrix returned is upper triangular.
  ## SPIKES should be a list of length N, N is the number of cells.
  ## "dt" is the maximum time for seeing whether two spikes are coincident.
  ## This is defined in the 1991 Meister paper.
  n <- length(spikes)
  if (n == 1) {
    ## If only one spike train, cannot compute the cross-corr indexes.
    0;
  } else {
    Tmax <- max(unlist(spikes))           #time of last spike.
    Tmin <- min(unlist(spikes))           #time of first spike.
    corrs <- array(0, dim=c(n,n))
    for ( a in 1:(n-1)) {
      n1 <- length(spikes[[a]])
      for (b in (a+1):n) {
        n2 <- length(spikes[[b]])
        corrs[a,b] <-  as.double(count.nab(spikes[[a]], spikes[[b]],dt) *
                                 (Tmax-Tmin)) /
                                   (as.double(n1) * n2 * (2*dt))
      }
    }
    if (any(is.na(corrs))) {
      stop("corrs has some NA values -- possible integer overflow in n1*n2, or zero spikes in one of the trains?")
    }
    corrs
  }
}



corr.index.means <- function(x) {
  ## Compute the mean,sd correlation index at each given distance.
  dists <- x$dists[which(upper.tri(x$dists))]
  corrs <- x$corr.indexes[which(upper.tri(x$corr.indexes))]

  dists.uniq <- unique(dists)
  num.dists <- length(dists.uniq)       #num of  different distances.

  ##print(dists.uniq)
  ## create 4-D array to store results.  Each row stores the
  ## distance, mean corr, sd, and num of values at that distance.

  res <- array(0,  dim=c(num.dists,4))
  colnames(res) <- c("dist","mean corr", "sd", "n")
  
  i <- 1

  for (d in dists.uniq) {
    ## find all correlations for pairs within 0.01um of given distance.
    cs <- corrs[ which(abs(dists-d)<0.01)]
    corrs.mean <- mean(cs)
    corrs.sd   <- sd(cs)
    res[i,] <- c(d, corrs.mean, corrs.sd, length(cs))
    i <- 1+i
  }

  res
}

corr.get.means <- function(id) {
  ## Compute the mean,sd of the correlation index at each distance.
  ## id is the array of [n,2] values.  Each row is [d,i].
  ## Returns a matrix.
  
  corr.get.means.helper <- function(x) {
    ## Helper function to create  mean and sd of one set of distances.
    indexes <- which(id[,1] == x)
    c(x, mean(id[indexes,2]), sd(id[indexes,2]), length(indexes))
    ##c(x, median(id[indexes,2]), mad(id[indexes,2]), length(indexes))
  }
  
  d.uniq <- sort(unique(id[,1]))
  means <- t(sapply(d.uniq, corr.get.means.helper))
  colnames(means) <- c("dist", "mean", "sd", "n")
  means
}

corr.do.fit <- function(id, plot=TRUE, show.ci=FALSE, ...) {
  ## Do the fit to the exponential and optionally plot it.  Any
  ## correlation index of zero is removed, since we cannot take the
  ## log of zero.  Hopefully there won't be too many of these.
  ## If SHOW.CI is true, do the fit with 95% confidence intervals.

  y.zero <- which(id[,2]==0)
  if (length(y.zero)>0) {
    id <- id[-y.zero,]
    warning(paste("removing", length(y.zero),"zero entries"))
  }
  x <- id[,1]
  y.log <- log(id[,2])
  fit <- lm(y.log ~ x)
  if (show.ci) {
    expt.new <- data.frame(x = seq(0, 850, 10))  #range of x for predictions.
    expt.clim <- predict(fit, expt.new, interval="confidence")
  }
  if (plot)  {
    if (show.ci) {
      ## Confidence intervals will show mean, so don't need
      ## to do both matlines and curve.
      matlines(expt.new$x, exp(expt.clim), lty=c(1,2,2),
               col="black")
    } else {
      curve(exp(fit$coeff[1]) * exp(x * fit$coeff[2]), add = TRUE,
            from=0, ...)
    }
  }
  fit
}

corr.check.fit <- function() {
  ## Simple test routine to see that the exponential fits are okay.
  a <- 40; b <- .01
  x <- seq(from=1, to=500, by=20)
  y <- a*exp(-b*x) + (2*rnorm(length(x)))
  plot(x,y, log="y")
  fit <- corr.do.fit( cbind(x,y), col=p9.col)
  
  ## should be similar to (a,b)
  print(exp(fit$coefficients))
}

my.upper <- function (x,diag=FALSE) {
  ## Return the upper triangular elements of a matrix on a
  ## column-by-column basis.
  ## e.g. my.upper(matrix(1:9, nrow=3), diag=TRUE).
  ## returns >>1 4 5 7 8 9<<
  if (is.matrix(x)) {
   x[ which(upper.tri(x,diag))]
  } else {
    stop(paste(deparse(substitute(x)),"is not a matrix"))
  }
}


## general.R --- File for generally useful functions.
## Author: Stephen J Eglen (2 functions from Ben Bolker's bbmisc package, GPL'ed)
## Copyright: GPL

file.or.gz <- function(file) {
  ## Return FILE if it exists, or FILE.gz if that exists.
  ## Otherwise, return NA and generate a warning.
  if (file.exists(file)) {
    file
  } else {
    f2 <- paste(file,".gz", sep="")
    if (file.exists(f2))
      f2
    else {
      warning(paste("File", file,
                    "could not be found, nor its compressed version."))
      NA
    }
  }
}

## plotCI() is taken from Ben Bolker's bbmisc package, which is under the GPL.
## http://www.zoo.ufl.edu/bolker/R/src/
## Update Tue 28 Nov 2006, now need clean.args also.

## remove arguments not intended for a particular function from a string
## repeated from bbfuns/misc.R
clean.args <- function(argstr,fn,exclude.repeats=FALSE,
                       exclude.other=NULL,dots.ok=TRUE) {
  fnargs <- names(formals(fn))
  if (length(argstr)>0 && !("..." %in% fnargs && dots.ok))  {
    badargs <- names(argstr)[!sapply(names(argstr),"%in%",c(fnargs,""))]
    for (i in badargs)
      argstr[[i]] <- NULL
  }
  if (exclude.repeats) {
    ntab <- table(names(argstr))
    badargs <- names(ntab)[ntab>1 & names(ntab)!=""]
    for (i in badargs)
      argstr[[i]] <- NULL
  }
  for (i in exclude.other)  ## additional arguments to exclude.other
    argstr[[i]] <- NULL
  argstr
}


plotCI <- function (x, y = NULL, uiw, liw = uiw,
                    ui=NULL, li=NULL,
                    err="y",
                    sfrac = 0.01, gap=0, slty=par("lty"),
                    add=FALSE,
                    scol=NULL,
                    pt.bg=par("bg"),
                    ...)  {
  ## from Bill Venables, R-list, modified with contributions and ideas
  ## from Gregory Warnes and the list
  ## requires clean.args()
  ## process arguments:
  arglist <- list(...)
  if (is.list(x)) {
    y <- x$y
    x <- x$x
  }
  if (is.null(y)) {
    if (is.null(x)) 
      stop("both x and y NULL")
    y <- as.numeric(x)
    x <- seq(along = x)
  }
  if (missing(uiw) && (is.null(ui) || is.null(li)))
    stop("must specify either relative limits or both lower and upper limits")
  if (!missing(uiw)) {  ## 
    if (err=="y") z <- y else z <- x
    ui <- z + uiw
    li <- z - liw
  }
  ## fill in default arguments
  if (is.null(arglist$"xlab"))
    arglist$"xlab" <- deparse(substitute(x))
  if (is.null(arglist$"ylab"))
    arglist$"ylab" <- deparse(substitute(y))
  if (err=="y" && is.null(arglist$"ylim"))
    arglist$"ylim" <- range(c(y, ui, li), na.rm=TRUE)
  if (err=="x" && is.null(arglist$"xlim"))
    arglist$"xlim" <- range(c(x, ui, li), na.rm=TRUE)
  if (missing(scol)) {
    if (!is.null(arglist$"col")) scol <- arglist$"col"
    else scol <- par("col")
  }
  plotpoints <- TRUE
  if (!is.null(arglist$"pch") && is.na(arglist$"pch")) {
    arglist$"pch" <- 1
    plotpoints <- FALSE
  }
  ## 
  if (!add)
    do.call("plot",c(list(x,y,type="n"),
                          clean.args(arglist,plot)))
  if (gap==TRUE) gap <- 0.01  ## default gap size: maybe too complicated?
  ul <- c(li, ui)
  if (err=="y") {
    gap <- rep(gap,length(x))*diff(par("usr")[3:4])
    smidge <- par("fin")[1] * sfrac
    arrow.args <- c(list(lty=slty,angle=90,length=smidge,code=1,
                         col=scol),
                    clean.args(arglist,arrows,
                               ## sje --- add "type"?
                               exclude.other=c("col","lty", "type")))
    do.call("arrows",c(list(x , li, x, pmax(y-gap,li)),
                       arrow.args))
    do.call("arrows",c(list(x , ui, x, pmin(y+gap,ui)),
                       arrow.args))
  }
  else if (err=="x") {
    gap <- rep(gap,length(x))*diff(par("usr")[1:2])
    smidge <- par("fin")[2] * sfrac
    arrow.args <- c(list(lty=slty,angle=90,length=smidge,code=1),
                    clean.args(arglist,arrows,exclude.other=c("col","lty")))
    do.call("arrows",c(list(li, y, pmax(x-gap,li), y),
                       arrow.args))
    do.call("arrows",c(list(ui, y, pmin(x+gap,ui), y),
                       arrow.args))
  }
  ## now draw the points (in case we want to have "bg" set for points)
  if (plotpoints)
    do.call("points",c(list(x, y, bg=pt.bg),
                       clean.args(arglist,points,
                                  exclude.other=c("xlab","ylab","xlim","ylim",
                                    "axes"))))
  invisible(list(x = x, y = y))
}

printf <- function (...) {
  ## Helper function.
  cat(sprintf(...))
}
## Implement logisi method for burst detection.
## Author: Zhengzheng Zhang
## Copyright: GPL.

logisi.par <- list(min.ibi=0.800,   min.durn=0.05, min.spikes=6,
                   isi.low=0.02)

logisi.find.burst <- function(spikes, debug=FALSE) {

  ## For one spike train, find the burst using log isi method.
  ## e.g.
  ## find.bursts(s$spikes[[5]])
  ## init.
  ## params currently in LOGISI.PAR
  ##

  no.bursts = NA;                       #value to return if no bursts found.


  par = logisi.par
  ##beg.isi =    par$beg.isi
  ##end.isi =    par$end.isi
  min.ibi =      par$min.ibi
  min.durn =     par$min.durn
  min.spikes =   par$min.spikes
  isi.low =      par$isi.low
  
  nspikes = length(spikes)

  ## Create a temp array for the storage of the bursts.  Assume that
  ## it will not be longer than Nspikes/2 since we need at least two
  ## spikes to be in a burst.
  
  max.bursts <- floor(nspikes/2)
  bursts <- matrix(NA, nrow=max.bursts, ncol=3)
  colnames(bursts) = c("beg", "end", "IBI")
  burst <- 0                            #current burst number

  ## Phase 1 -- burst detection. Each interspike interval of the data 
  ## is compared with the threshold THRE. If the interval is greater 
  ## than the threshold value, it can not be part of a burst; if the 
  ## interval is smaller or equal to the threhold, the interval may be 
  ## part of a burst.
 


  ## LAST.END is the time of the last spike in the previous burst.
  ## This is used to calculate the IBI.
  ## For the first burst, this is no previous IBI
  last.end = NA;                        #for first burst, there is no IBI.

  n = 2
  in.burst = FALSE
  
  while ( n < nspikes) {
    
    next.isi = spikes[n] - spikes[n-1]
    if (in.burst) {
      if (next.isi > isi.low) {
        ## end of burst
        end = n-1; in.burst = FALSE

        
        ibi =  spikes[beg] - last.end; last.end = spikes[end]
        res = c(beg, end, ibi)
        burst = burst + 1
        if (burst > max.bursts) {
          print("too many bursts!!!")
          browser()
        }
        bursts[burst,] <- res
      }
    } else {
      ## not yet in burst.
      if (next.isi <= isi.low) {
        ## Found the start of a new burst.
        beg = n-1; in.burst = TRUE
      }
    }
    n = n+1
  }

  ## At the end of the burst, check if we were in a burst when the
  ## train finished.
  if (in.burst) {
    end = nspikes
    ibi =  spikes[beg] - last.end
    res = c(beg, end, ibi)
    burst = burst + 1
    if (burst > max.bursts) {
      print("too many bursts!!!")
      browser()
    }
    bursts[burst,] <- res
  }

  ## Check if any bursts were found.
  if (burst > 0 ) {
    ## truncate to right length, as bursts will typically be very long.
    bursts = bursts[1:burst,,drop=FALSE]
  } else {
    ## no bursts were found, so return an empty structure.
    return(no.bursts)
  }
  
  if (debug) {
    print("End of phase1\n")
    print(bursts)
  }
  

  ## Phase 2 -- merging of bursts.  Here we see if any pair of bursts
  ## have an IBI less than MIN.IBI; if so, we then merge the bursts.
  ## We specifically need to check when say three bursts are merged
  ## into one.
  
  
  ibis = bursts[,"IBI"]
  merge.bursts = which(ibis < min.ibi)
  
  if (any(merge.bursts)) {
    ## Merge bursts efficiently.  Work backwards through the list, and
    ## then delete the merged lines afterwards.  This works when we
    ## have say 3+ consecutive bursts that merge into one.

    for (burst in rev(merge.bursts)) {
      bursts[burst-1, "end"] = bursts[burst, "end"]
      bursts[burst, "end"] = NA         #not needed, but helpful.
    }
    bursts = bursts[-merge.bursts,,drop=FALSE] #delete the unwanted info.
  }

  if (debug) {
    print("End of phase 2\n")
    print(bursts)
  }


  ## Phase 3 -- remove small bursts: less than min duration (MIN.DURN), or
  ## having too few spikes (less than MIN.SPIKES).
  ## In this phase we have the possibility of deleting all spikes.

  ## LEN = number of spikes in a burst.
  ## DURN = duration of burst.
  len = bursts[,"end"] - bursts[,"beg"] + 1
  durn = spikes[bursts[,"end"]] - spikes[bursts[,"beg"]]
  bursts = cbind(bursts, len, durn)

  rejects = which ( (durn < min.durn) | ( len < min.spikes) )
  
  if (any(rejects)) {
    bursts = bursts[-rejects,,drop=FALSE]
  }

  if (nrow(bursts) == 0) {
    ## All the bursts were removed during phase 3.
    bursts = no.bursts
  } else {
    ## Compute mean ISIS
    len = bursts[,"end"] - bursts[,"beg"] + 1
    durn = spikes[bursts[,"end"]] - spikes[bursts[,"beg"]]
    mean.isis = durn/(len-1)

    ## Recompute IBI (only needed if phase 3 deleted some cells).
    if (nrow(bursts)>1) {
      ibi2 = c(NA, calc.ibi(spikes, bursts))
    } else {
      ibi2 = NA
    }
    bursts[,"IBI"] = ibi2
    
    SI = rep(1, length(mean.isis ))
    bursts = cbind(bursts, mean.isis, SI)
  }
  
  ## End -- return burst structure.
  bursts
 
}


## Peak finding algorithm; taken from R-help mailing list.
## Author: Brian Ripley.
locpeaks <- function (series, span = 3)
{
    z <- embed(series, span)
    s <- span%/%2
    v <- max.col(z) == 1 + s
    result <- c(rep(FALSE, s), v)
    result <- result[1:(length(result) - s)]
    which(result)
}

logisi.compute <- function(s, min.nspikes = 10,
                           breaks.max = 100,
                           channel = ncells+1,
                           span = 1, span.max = 50, Rat = 0.08, plot = FALSE)
{

  ## N --> MIN.NSPIKES == minimum number of spikes in a channel.
  ## br.max --> breaks.max
  ## channel.
  ## 
  ## Given the spike data structure S,
  ## compute the log ISI transform and return useful information.

  ## This function should be expanded to find the peaks in the
  ## histogram either of each channel or of the grand average.
  
  h = list()                                                 # hist objects  
  total.isi = NULL
  ncells <- s$NCells
  if (plot){
      par(mfrow=c(8,8), mar=c(3,3,1,1), ask=FALSE, oma=c(0,1.5,0,0))
  }
  
  for (i in 1:ncells){
    if (s$nspikes[i] >= min.nspikes ) {
      ## Channel has "enough" spikes for method.
      isi = diff( s$spikes[[i]] )
      total.isi =c(total.isi, isi) 
      B = sqrt(s$nspikes[i])
      if (B > breaks.max){
          B = breaks.max
      }
      if (plot){
          title = sprintf("%d # %d", i, s$nspikes[i])
          h[[i]] = hist(log(isi), br = B, main = title, xlab = "logisi")
          abline(h = mean(h[[i]]$counts), col = 'blue')
      } else{
             h[[i]] = hist(log(isi), br = B, plot = FALSE)
      }
    } else {
      ## insufficient spikes to compute ISI histogram.
      if (plot){
          title = sprintf("%d # %d", i, s$nspikes[i])
          plot(1, type='n', main=title)
      }
    }
  }

  ## The log histogram for the grand average.
  B = sqrt(length(total.isi))
  if (B > breaks.max){
    B = breaks.max
  }
  file = s$file
  if (plot){
      last.h = hist(log(total.isi), br = B, main = "All", xlab = "logisi")                             
      abline(h = mean(last.h$counts), col = 'red')
      mtext(file, side=2, outer=TRUE)
  }else{
        last.h = hist(log(total.isi), br = B, plot = FALSE) 
  }
  h[[ncells+1]] = last.h
  counts = h[[channel]]$counts
  breaks = h[[channel]]$breaks

  if (plot){
      ## Find the peaks in the histogram 
      ## either of each channel or of the grand average.
      par(mfrow=c(1,1))
      plot(counts, type='l', xlab="Logisi (ms)", ylab="Frequency", xaxt="n")
      axis(1, 0:length(counts), format(exp(breaks), sci=TRUE))   
  }   
  peaks = locpeaks(counts, span)
 
  ## Return some dummy values; these might be times of thresholds.
  ## e.g. max1 might be the time of the first peak interval.
  ## res <- list(max1=.1, max2=.4)
  MAX = max(counts)
  if (length(peaks)==0){
      peak.max = -Inf
  }else{
        peak.max = max(counts[peaks])
  }     

  if (span.max >= length(counts)){
      span.max = length(counts) -1 
  }
    
  ## Find the no. of peaks no more than 6, and
  ## the golobal max is one of peaks.
  while(length(peaks) >6 || MAX!=peak.max){
        span= span + 1
        peaks = locpeaks(counts, span)
        if (length(peaks)==0){
            peak.max = -Inf
        }else{
              peak.max = max(counts[peaks])
        }    
        if (span > span.max){
            peaks = 0
            break
        }
  }


  if (length(peaks)!=1 || (length(peaks)==1&& peaks!=0)){
      if (plot){  
          points( peaks, counts[peaks], pch=19, col='blue')
      }
  }else{
        browser()
  }     

  ## Find the local minimums between two successive peaks, and report the lowest.
  ## If the peak finding algorithm gives some unlikely peaks between them,
  ## then the peaks will be filtered out.
  ## Rat = 0.08        # a threhold for filtering unreasonable peaks

  pos = -1             # flag
  len = length(peaks)  # initial length
  j = 1
  mini = NULL
  R= NULL

  while (pos==-1 || j < len){
         len = length(peaks)
         if (len >= 2){
             loc.min = min(counts[peaks[j]:peaks[j+1]])
             temp = c(peaks[j]:peaks[j+1])
             pos = temp[counts[peaks[j]:peaks[j+1]]==loc.min]
             pos = pos[length(pos)]           # last local min
             pair = c(counts[peaks[j]], counts[peaks[j+1]])
             smallest = c(j,j+1)[which.min(pair)]  
             Diff = counts[peaks[smallest]] - counts[pos]
             ## If the second peaks occurs after the first in the next 3 
             ## breaks, then remove the smallest peak.
             if (diff(peaks[j:(j+1)])<=3){
                 peaks = peaks[-smallest]
                 pos = -1
                 j=1
             }else{ 
                   if (Diff==0){
                       peaks = peaks[-smallest]
                       pos = -1
                       j=1
                   }else{
                         ## define a ratio
                         ratio = Diff/(max(counts[peaks]) - counts[pos])
                         ## If the ratio is less than Rat, remove the smallest peak.
                         if (ratio < Rat){
                             peaks = peaks[-smallest]
                             pos = -1
                             j=1
                         }else{
                               if (ratio < 0 || ratio > 1){
                               browser()
                               }
                               mini = c(mini, pos)
                               R = c(R, ratio)
                               j = j+1
                         }
                   }  
             } 

         }else{
               lowest = -2
               break
         }  
  }
  if (length(mini)!=0){
      M = min(counts[mini])
      lowest = mini[counts[mini] == M][1]           # choose the first
  }else{
        lowest = -2
  }

  if (lowest != -2){
      if (plot){
                points( lowest, counts[lowest], pch=19, col='red')
      }
      a1 = h[[channel]]$breaks[lowest]
      a2 = h[[channel]]$breaks[lowest+1]
      av.a = (a1+a2)/2
      loc.min = exp(av.a)
  }else{
      loc.min = NA                     
  }  



  b1 = h[[channel]]$breaks[peaks]
  b2 = h[[channel]]$breaks[peaks+1]
  av.b = (b1+b2)/2
  isi.peaks = exp(av.b)                             # time in seconds   
  res = list(max1=isi.peaks[1], max2=isi.peaks[2], max3=isi.peaks[3])
       
  return(list(Max=res,Locmin=loc.min))

}
## maxinterval.R --- maxinterval burst detection (from Neuroexplorer).
## Author: Stephen Eglen
## Copyright: GPL
## Fri 23 Feb 2007


mi.find.bursts <- function(spikes,debug=FALSE) {

  ## For one spike train, find the burst using max interval method.
  ## e.g.
  ## find.bursts(s$spikes[[5]])
  ## init.
  ## params currently in MI.PAR
  ##

  no.bursts = NA;                       #value to return if no bursts found.

  par = mi.par
  beg.isi =    par$beg.isi
  end.isi =    par$end.isi
  min.ibi =    par$min.ibi
  min.durn =   par$min.durn
  min.spikes = par$min.spikes
  
  nspikes = length(spikes)

  ## Create a temp array for the storage of the bursts.  Assume that
  ## it will not be longer than Nspikes/2 since we need at least two
  ## spikes to be in a burst.
  
  max.bursts <- floor(nspikes/2)
  bursts <- matrix(NA, nrow=max.bursts, ncol=3)
  colnames(bursts) = c("beg", "end", "IBI")
  burst <- 0                            #current burst number

  ## Phase 1 -- burst detection.  Here a burst is defined as starting
  ## when two consecutive spikes have an ISI less than BEG.ISI apart.
  ## The end of the burst is given when two spikes have an ISI greater
  ## than END.ISI.
  
  ## Find ISIs closer than beg.isi, and end with end.isi.


  ## LAST.END is the time of the last spike in the previous burst.
  ## This is used to calculate the IBI.
  ## For the first burst, this is no previous IBI
  last.end = NA;                        #for first burst, there is no IBI.

  n = 2
  in.burst = FALSE
  
  while ( n < nspikes) {
    
    next.isi = spikes[n] - spikes[n-1]
    if (in.burst) {
      if (next.isi > end.isi) {
        ## end of burst
        end = n-1; in.burst = FALSE

        
        ibi =  spikes[beg] - last.end; last.end = spikes[end]
        res = c(beg, end, ibi)
        burst = burst + 1
        if (burst > max.bursts) {
          print("too many bursts!!!")
          browser()
        }
        bursts[burst,] <- res
      }
    } else {
      ## not yet in burst.
      if (next.isi < beg.isi) {
        ## Found the start of a new burst.
        beg = n-1; in.burst = TRUE
      }
    }
    n = n+1
  }

  ## At the end of the burst, check if we were in a burst when the
  ## train finished.
  if (in.burst) {
    end = nspikes
    ibi =  spikes[beg] - last.end
    res = c(beg, end, ibi)
    burst = burst + 1
    if (burst > max.bursts) {
      print("too many bursts!!!")
      browser()
    }
    bursts[burst,] <- res
  }

  ## Check if any bursts were found.
  if (burst > 0 ) {
    ## truncate to right length, as bursts will typically be very long.
    bursts = bursts[1:burst,,drop=FALSE]
  } else {
    ## no bursts were found, so return an empty structure.
    return(no.bursts)
  }
  
  if (debug) {
    print("End of phase1\n")
    print(bursts)
  }
  
  
  ## Phase 2 -- merging of bursts.  Here we see if any pair of bursts
  ## have an IBI less than MIN.IBI; if so, we then merge the bursts.
  ## We specifically need to check when say three bursts are merged
  ## into one.
  
  
  ibis = bursts[,"IBI"]
  merge.bursts = which(ibis < min.ibi)
  
  if (any(merge.bursts)) {
    ## Merge bursts efficiently.  Work backwards through the list, and
    ## then delete the merged lines afterwards.  This works when we
    ## have say 3+ consecutive bursts that merge into one.

    for (burst in rev(merge.bursts)) {
      bursts[burst-1, "end"] = bursts[burst, "end"]
      bursts[burst, "end"] = NA         #not needed, but helpful.
    }
    bursts = bursts[-merge.bursts,,drop=FALSE] #delete the unwanted info.
  }

  if (debug) {
    print("End of phase 2\n")
    print(bursts)
  }


  ## Phase 3 -- remove small bursts: less than min duration (MIN.DURN), or
  ## having too few spikes (less than MIN.SPIKES).
  ## In this phase we have the possibility of deleting all spikes.

  ## LEN = number of spikes in a burst.
  ## DURN = duration of burst.
  len = bursts[,"end"] - bursts[,"beg"] + 1
  durn = spikes[bursts[,"end"]] - spikes[bursts[,"beg"]]
  bursts = cbind(bursts, len, durn)

  rejects = which ( (durn < min.durn) | ( len < min.spikes) )
  
  if (any(rejects)) {
    bursts = bursts[-rejects,,drop=FALSE]
  }

  if (nrow(bursts) == 0) {
    ## All the bursts were removed during phase 3.
    bursts = no.bursts
  } else {
    ## Compute mean ISIS
    len = bursts[,"end"] - bursts[,"beg"] + 1
    durn = spikes[bursts[,"end"]] - spikes[bursts[,"beg"]]
    mean.isis = durn/(len-1)

    ## Recompute IBI (only needed if phase 3 deleted some cells).
    if (nrow(bursts)>1) {
      ibi2 = c(NA, calc.ibi(spikes, bursts))
    } else {
      ibi2 = NA
    }
    bursts[,"IBI"] = ibi2
    
    SI = rep(1, length(mean.isis ))
    bursts = cbind(bursts, mean.isis, SI)
  }
  
  ## End -- return burst structure.
  bursts
  
}

## mm_mea.R --- Code for reading Markus Meister's MEA data.
## Author: Stephen Eglen
## Copyright: GPL
## Mon 15 Jan 2007
## This is code for the array data from Markus Meister (MM)
## not likely to be useful for CARMEN, as it was a handbuilt array
## used for the data that appeared in (Meister et al., 1991) on retinal waves
## in developing retina.


## * Markus's functions.

## These are some constants assumed in Markus's functions.
mm.WrapTime <- 16** 4 * 128        #Clock wraparound in tics, ca 419s.
mm.sample.rate <- 20000.0               #20KHz sample rate.
mm.burst.sep <- 10
mm.num.electrodes <- 63                 #of these, 61 usuable...
## Size of the various data types.
mm.longsize <- 4; mm.floatsize <- 4; mm.intsize <- 2; mm.unsize <- 2


mm.readpos <- function(posfile) {
  ## Read in a .pos file that has been generated by Markus' MAC program.
  x <- read.table(posfile,sep="\t", skip=5, header=FALSE)
  res <- cbind(x$V2, x$V3)
  if (dim(x)[2] == 4) rownames(res) <- as.character(x$V4)
  class(res) <- "mm.pos"
  res
}

## File ~ms/ms_sje_pos.text has been converted into a data file using:
## mmpos <- mm.readpos("~/ms/ms_sje_pos.text")
## save(mmpos, file = "mmpos.rda", ascii=TRUE)
## This file was then put in the data subdirectory.

mm.readpos.compare <- function(NCells, boxes, posfile) {
  ## Generate the multisite positions.
  ## Read in the position file if it was given to compare with my
  ## assignment of channels to electrode positions.
  guess.pos <- array(0, dim=c(NCells,2))
  ##mm.pos <- mm.readpos("~/ms/ms_sje_pos.text")
  ## shouldn't have to load data() each time...
  data(mmpos)
  for (i in 1:NCells) {
    matches <- which(boxes[,1] == i)
    ##cat(paste("matches for cell",i,":",matches, "\n"))
    if (length(matches) == 0) {
      stop(paste("no matches found for cell",i))
    }
    channel <- boxes[matches[1],2]
    guess.pos[i,] <- mmpos[channel,]
  }
  if (is.character(posfile)) {

    if (!file.exists(posfile))
      stop(paste("Position file",posfile,"does not exist"))
    
    ## now read in the spike position file.  Always return this
    ## if it is available.
    pos <- mm.readpos(posfile)
    if (NCells != dim(pos)[1]) {
      stop(paste("NCells against size in this.pos differs",
                 NCells, dim(pos)[1], "\n"))
    }

    ## compare the computed positions with those points read in from
    ## Markus' program.
    diffs <- pos - guess.pos
    dists <- apply(diffs, 1, function(x) { sqrt(sum(x**2))})
    if (any(dists)) {
      warning(paste("some cell positions wrong\n",
                    paste(which(dists >0),
                          signif(dists[which(dists>0)],4), "\n",
                          collapse=" "),"\n"))
    }
  } else {
    ## no data file, so just take guess.
    pos <- guess.pos
  }

  class(pos) <- "mm.pos"
  pos
}

plot.mm.pos <- function(x, use.rownames=FALSE) {
  ## Show the layout of Markus' electrodes within the array.
  range <- c(-300,300)
  plot(x[,1], x[,2], asp=1,
       xlim=range, ylim=range, xlab="", ylab="", type="n")
  if (use.rownames)
    text(x[,1], x[,2], rownames(x))
  else
    text(x[,1], x[,2])
}

read.ms.mm.data <- function(cellname, posfile=NULL) {
  ## Read in the multisite data and return a list with all the relevant
  ## data.  Determine the format of the file then call the appropriate
  ## routine (format1, format2).

  if(is.null(posfile) ) {
    posfile <- paste(cellname, ".pos", sep='')
    if (!file.exists(posfile))
      posfile <- NULL
    else
      cat(paste("guess posfile:",posfile, "\n"))
  }
    
  fp <- file(cellname , 'rb')
  Format <- readBin(fp, integer(), 1, mm.longsize, endian="big")
  close(fp)

  if (Format == 2) {
    cat(paste("Guessing",cellname, "is format 2\n"))
    res <- read.ms.mm.data.format2(cellname, posfile)
  } else {
    cat(paste("Guessing",cellname, "is format 1\n"))
    res <- read.ms.mm.data.format1(cellname, posfile)
  }

  ## meanfiring rate is the number of spikes divided by the (time of
  ## last spike - time of first spike).  
  meanfiringrate <- res$nspikes /
    ( sapply(res$spikes, max) - sapply(res$spikes, min))

  ## Do some things common to both formats.
  dists <- make.distances(res$pos)

  ##mm.distance.breaks <- c(0, 35, 105, 175, 245, 315, 385, 455, 525, 595)
  mm.distance.breaks <- c(0, seq(35, by=70, length=9))
  mm.distance.breaks.strings <-
    levels(cut(0, mm.distance.breaks, right=FALSE, include.lowest=TRUE))

  dists.bins   <- bin.distances(dists, mm.distance.breaks)
  corr.indexes.dt <- 0.05
  corr.indexes <- make.corr.indexes(res$spikes, corr.indexes.dt)
  res$dists <- dists
  res$dists.bins <- dists.bins
  res$corr.indexes <- corr.indexes
  res$corr.indexes.dt <- corr.indexes.dt
  corr.id <- cbind(my.upper(dists), my.upper(corr.indexes))  
  corr.id.means <- corr.get.means(corr.id)
  res$corr.id <- corr.id
  res$corr.id.means <- corr.id.means
  res$distance.breaks <- mm.distance.breaks
  res$distance.breaks.strings <- mm.distance.breaks.strings
  res$rates <- make.spikes.to.frate(res$spikes)
  class(res) <- "mm.s"
  res
}

read.ms.mm.data.format2 <- function(cellname, posfile=NULL) {
  ## Read in the multisite data and return a list with all the relevant
  ## data (format 2).

  ## Get the total size of the file so it can be compared with value
  ## of seek() once all the data have been read in.
  filesize <- file.info(cellname)$size
  
  fp <- file(cellname , 'rb')
  seek(fp,0)
  Format <- readBin(fp, integer(), 1, mm.longsize, endian="big")
  t <- readBin(fp, integer(), 4, mm.longsize, endian="big")
  FileIndex <- t[1]; BoxIndex <- t[2]; RecIndex <- t[3]; StatIndex <- t[4]

  ## Now read the NFiles...
  seek(fp, 64)
  t <- readBin(fp, integer(), 4, mm.intsize, endian="big")
  NFiles <- t[1]; NBoxes <- t[2]; NRecords <- t[3]; NCells <- t[4]

  if (NFiles>1)
    warning(paste("NFiles larger than 1 - check ok? - e.g. endTimes",
                  NFiles, "\n"))
  
  t <- readBin(fp, integer(), 2, mm.longsize, endian="big")
  NEvents <- t[1]; NSpikes <- t[2]
  cat(paste("NEvents", NEvents, "NSpikes", NSpikes, "\n"))

  ## Read in the fileinfo.
  if (seek(fp) != FileIndex)
    stop("error - current file position different from expected FileIndex")

  seek(fp, FileIndex)
  for (r in 1:NFiles) {
    vrn <- readBin(fp, integer(), 1, mm.intsize, endian="big")
    pfilename <- readChar(fp, 64)
    pdirname <- readChar(fp, 64)
    flcrdat  <- readBin(fp, integer(), 1, mm.longsize, endian="big")
    t <- readBin(fp, integer(), 3, mm.intsize, endian="big")
    LowRecord <- t[1]; nrec <- t[2]; LastRecord <- t[3];
    cat(paste("File", r, "name", pfilename, "dir", pdirname,
              "nrec", nrec, "LastRecord", LastRecord, "\n"))
  }

  ## Read in the Box Info ####################
  if (seek(fp) != BoxIndex)
    stop("error - current file position different from BoxIndex")

  ## Make an array to store the boxes.
  boxes <- array(0, dim= c(NBoxes, 7))
  ## todo -- determine how these boxes relate to position of neurons.
  seek(fp, BoxIndex)
  for (r in 1:NBoxes) {
    t <- readBin(fp, integer(), 7, mm.intsize, endian="big")
    group <- t[1]; channel <- t[2]; plott <- t[3]
    ##cat(paste("Box", r, "Group", group, "Chan", channel,
    ##"Plot", plott, "bounds", t[4], t[5], t[6], t[7], "\n"))
    boxes[r,] <- t
  }


  ## now parse the RecIndex... ####################

  if (seek(fp) != RecIndex)
    stop(paste("seek position different from expected RecIndex",
               seek(fp), RecIndex))

  ## RecIndex points to an array of length NRecords, each which points
  ## to the start of the rth record.

  seek(fp,RecIndex)
  RecordIndexes <- readBin(fp, integer(), NRecords, mm.longsize, endian="big")

  ## Parse each record...

  startclock <- integer(NRecords)
  endclock   <- integer(NRecords)
  starttimes <- integer(NRecords)       #to be calculated...
  endtimes   <- integer(NRecords)
  nevents    <- integer(NRecords)
  nspikes.rec<- integer(NRecords)

  spikecount <- 0
  eventcount <- 0
  laststop   <- 0

  ## Make an empty list of size NCells.  Each element will be a list.
  allspikes <- list()
  for (i in 1:NCells) {
    allspikes[i] <- list()
  }
  EndTime <- 0;                        #todo: start of each file?

  for (r in 1:NRecords) {

    if ((laststop >0) && (seek(fp) != laststop)) {
      stop(paste("Error: RecordIndex and position of last byte differ",
                 "Record", r, "start", start, "laststop", laststop))
    }
    
    seek(fp, RecordIndexes[r])
    startclock[r] <- readBin(fp, integer(), 1, mm.unsize, signed=FALSE,
                             endian="big")
    endclock[r]   <- readBin(fp, integer(), 1, mm.unsize, signed=FALSE,
                             endian="big")
    nevents[r]    <- readBin(fp, integer(), 1, mm.longsize, endian="big")
    nspikes.rec[r]<- readBin(fp, integer(), 1, mm.longsize, endian="big")


    ShiftTime <- (EndTime %/% mm.WrapTime) * mm.WrapTime
    while ( ( (startclock[r] * 128) + ShiftTime) < EndTime)
      ShiftTime <- ShiftTime + mm.WrapTime

    starttimes[r] <- (startclock[r] * 128) + ShiftTime
    
    cat(paste(r, "clock", startclock[r], endclock[r], "#events", nevents[r],
              "#spikes", nspikes.rec[r], "\n"))
    spikecount <- spikecount + nspikes.rec[r]
    eventcount <- eventcount + nevents[r]
    ## Read in the number of spikes from each cell in record r.
    spikespercell <- readBin(fp, integer(), NCells, mm.longsize, endian="big")

    ## Read in the time of event.
    eventsinrecord <- readBin(fp, integer(), nevents[r],mm.longsize, endian="big")

    ## width of events
    we <- readBin(fp, integer(), nevents[r], mm.intsize, endian="big")

    ## peak of events
    pe <- readBin(fp, integer(), nevents[r], mm.intsize, endian="big")

    ## time of each spike from each cell in record r
    TLast <- -1
    for (cell in 1:NCells) {
      nspikescell <- spikespercell[cell]
      spiketimes <- readBin(fp, integer(), nspikescell, mm.longsize, endian="big")


      if (nspikescell >0 ) {
        spiketimes <- spiketimes + ShiftTime
        lastspiketime <- spiketimes[nspikescell]
        if ( TLast < lastspiketime)
          TLast <- lastspiketime
      }
      
      if (r == 1)
        allspikes[cell] <- list(spiketimes)
      else
        allspikes[cell] <- list(c(allspikes[[cell]],spiketimes))
    }


    ## Now check the end time.
    ##cat(paste("before: EndTime", EndTime, "TLast", TLast, "\n"))
    if (EndTime < TLast)
      EndTime <- TLast

    endtimes[r] <- ( (endclock[r]+1)* 128) +
      ((EndTime %/% mm.WrapTime) * mm.WrapTime)

    if (endtimes[r] < EndTime) {
      endtimes[r] <- endtimes[r] + mm.WrapTime
      cat(paste("wraptime added", mm.WrapTime, "\n"))
    }

    EndTime <- endtimes[r]
    
    ## this is the end of the loop for this record.
    laststop <- seek(fp)                     # used for counting purposes.



  }
  if (spikecount != NSpikes)
    stop(paste ("spikecount differs from expected value",
                spikecount, Nspikes))

  if (eventcount != NEvents)
    stop(paste ("eventcount differs from expected value",
                eventcount, Nevents))

  ## Check the C values
  if (seek(fp) != StatIndex)
    stop(paste ("StatIndex problem", stop, StatIndex))

  C <- readBin(fp, integer(), NCells, mm.intsize, endian="big")
  SpikesInCell <- readBin(fp, integer(), NCells, mm.longsize, endian="big")

  if (( sum(SpikesInCell) != NSpikes))
    stop("Error in the total number of spikes in cell")

  ## Can also check SpikesInCell with the sum of spikes
  count.allspikes <- sapply(allspikes, length)
  if (sum(abs(count.allspikes - SpikesInCell)) > 0)
    stop("Counts of spikes differs...")

  Pe <- readBin(fp, numeric(), NCells, mm.floatsize, endian="big")
  Wi <- readBin(fp, numeric(), NCells, mm.floatsize, endian="big")
  PP <- readBin(fp, numeric(), NCells, mm.floatsize, endian="big")
  WP <- readBin(fp, numeric(), NCells, mm.floatsize, endian="big")
  WW <- readBin(fp, numeric(), NCells, mm.floatsize, endian="big")
  CrossF <- readBin(fp, numeric(), NCells*mm.num.electrodes, mm.floatsize, endian="big")
  CrossR <- readBin(fp, numeric(), NCells*mm.num.electrodes, mm.floatsize, endian="big")

  dim(CrossF) <- c(NCells,mm.num.electrodes)
  dim(CrossR) <- c(NCells,mm.num.electrodes)
  if ( seek(fp) != filesize)
    stop(paste("difference at end of file", seek(fp), filesize))

  ## End of processing this file.
  close(fp)

  pos <- mm.readpos.compare(NCells, boxes, posfile)

  ## Convert spike times into seconds.
  allspikes <- lapply(allspikes, function(x) { x / mm.sample.rate})

  ## check that the spikes are monotonic.
  check.spikes.monotonic(allspikes)
  bursts <- lapply(allspikes, function(x) spikes.to.bursts(x, mm.burst.sep))

  ## Check that the number of spikes matches the number we return in "spikes"
  if (NSpikes != sum(sapply(allspikes,length)))
    stop("NSpikes and actual number of spikes differ")

  
  res <- list (NFiles=NFiles, NBoxes=NBoxes, NRecords = NRecords,
               NSpikes=NSpikes, NEvents=NEvents,
               startclock=startclock, endclock=endclock,
               nevents=nevents, nspikes.rec=nspikes.rec,
               starttimes=starttimes,
               endtimes=endtimes,
               NCells=NCells, boxes=boxes, C=C,
               spikes=allspikes,
               nspikes=sapply(allspikes, length),
               bursts=bursts,
               CrossF=CrossF, CrossR=CrossR, Pe=Pe,
               file=cellname,
               pos=pos)
  class(res) <- "mm.s"
  res
}

read.ms.mm.data.format1 <- function(cellname, posfile=NULL) {
  ## Read in the multisite data and return a list with all the relevant
  ## data.  This assumes the data is in format 1.

  ## Get the total size of the file so it can be compared with value
  ## of seek() once all the data have been read in.
  filesize <- file.info(cellname)$size

  fp <- file(cellname , 'rb')
  seek(fp,0)
  t <- readBin(fp, integer(), 4, mm.intsize, endian="big")
  
  NFiles <- t[1]; NBoxes <- t[2]; NRecords <- t[3]; NCells <- t[4]

  t <- readBin(fp, integer(), 2, mm.longsize, endian="big")
  NSpikes <- t[1]; NEvents <- t[2];
  
  cat(paste("NFiles", NFiles, "NBoxes", NBoxes, "NRecords", NRecords,
            "NCells", NCells, "\n"))
  cat(paste("NEvents", NEvents, "NSpikes", NSpikes, "\n"))


  ## Read in the file information
  for (r in 1:NFiles) {
    vrn <- readBin(fp, integer(), 1, mm.intsize, endian="big")
    pfilename <- readChar(fp, 64)
    pdirname <- readChar(fp, 64)
    flcrdat  <- readBin(fp, integer(), 1, mm.longsize, endian="big")
    t <- readBin(fp, integer(), 3, mm.intsize, endian="big")
    LowRecord <- t[1]; nrec <- t[2]; LastRecord <- t[3];
    cat(paste("File", r, "name", pfilename, "dir", pdirname,
              "nrec", nrec, "LastRecord", LastRecord, "\n"))
  }

  ## Read in the Box Info ####################
  boxes <- array(0, dim= c(NBoxes, 7))
  for (r in 1:NBoxes) {
    t <- readBin(fp, integer(), 7, mm.intsize, endian="big")
    group <- t[1]; channel <- t[2]; plott <- t[3]
    ##cat(paste("Box", r, "Group", group, "Chan", channel,
    ##"Plot", plott, "bounds", t[4], t[5], t[6], t[7], "\n"))
    boxes[r,] <- t
  }

  startclock <- readBin(fp, integer(), NRecords,mm.unsize,signed=FALSE,
                        endian="big")
  endclock   <- readBin(fp, integer(), NRecords,mm.unsize,signed=FALSE,
                        endian="big")

  cat("start and end times\n")
  print(startclock); print(endclock)
  SpikesInRecords <- readBin(fp, integer(), NRecords, mm.longsize, endian="big")
  SpikesInCell    <- readBin(fp, integer(),   NCells, mm.longsize, endian="big")


  ## This seems to duplicate the information in the boxes.
  C              <- readBin(fp, integer(),   NCells,  mm.intsize, endian="big")
  ## cat("about to print C\n");   print(C)
  ##cat(paste("after reading C, file pos is", seek(fp), "\n"))


  ##   Pe <- readBin(fp, numeric(), NCells, doublesize, endian="big")
  ##   print(Pe[1:20])
  ##   Wi <- readBin(fp, numeric(), NCells, doublesize, endian="big")
  ##   PP <- readBin(fp, numeric(), NCells, doublesize, endian="big")
  ##   WP <- readBin(fp, numeric(), NCells, doublesize, endian="big")
  ##   WW <- readBin(fp, numeric(), NCells, doublesize, endian="big")

  ##   CrossF <- readBin(fp, numeric(), NCells*mm.num.electrodes, doublesize, endian="big")
  ##   CrossR <- readBin(fp, numeric(), NCells*mm.num.electrodes, doublesize, endian="big")
  ##   dim(CrossF) <- c(NCells,mm.num.electrodes)
  ##   dim(CrossR) <- c(NCells,mm.num.electrodes)

  ## double is 10 bytes according to my calculations.
  ## Markus acknowledges that the double format in ThinkC (MAC) is curious
  ## so  for now, I'm just reading in blocks of 10 bytes.  131 is
  ## derived from (mm.num.electrodes + mm.num.electrodes) + 5 
  tempstuff <- readBin(fp, integer(), NCells*131*10/2, 2, endian="big")
  
  ## Number of spikes from each cell in each record
  N <- readBin(fp, integer(), NCells*NRecords, mm.longsize, endian="big")
  dim(N) <- c(NCells,NRecords)
  ##cat("N\n");print(N)

  ## The N array is useful for knowing which spikes belong to which cell
  ## and which record.
  if (any(apply(N, 2, sum) != SpikesInRecords))
    stop("SpikesInRecords and Col sum of N differ")

  ## All spike times for each cell (and for each record) are read
  ## in at once, and stored in a big T array.
  ## Time of each spike from each cell in each record
  my.num.spikes <- sum(N)
  cat(paste("my.num.spikes", my.num.spikes, "\n"))
  T <- readBin(fp, integer(), my.num.spikes, mm.longsize, endian="big")

  breaks <- as.vector(N)
  high <- cumsum(breaks)
  low <- c(1, high[1:(length(high)-1)]+1)

  spikes <- apply(cbind(low, breaks), 1,
                  function (i) {
                    num <- i[2];
                    if (num > 0)        #return spikes if there are some
                      res <- T[i[1]:(i[1]+(num-1))]
                    else                #return empty vector
                      res <- numeric(0)
                    res
                  })

  starttimes <- integer(NRecords)       #to be calculated...
  endtimes   <- integer(NRecords)
  nevents    <- integer(NRecords)
  nspikes.rec<- integer(NRecords)

  ## Make an empty list of size NCells.  Each element will be a list.
  allspikes <- list()
  for (i in 1:NCells) allspikes[i] <- list()
  EndTime <- 0;                        #todo: start of each file?

  for (r in 1:NRecords) {

    ShiftTime <- (EndTime %/% mm.WrapTime) * mm.WrapTime
    while ( ( (startclock[r] * 128) + ShiftTime) < EndTime)
      ShiftTime <- ShiftTime + mm.WrapTime

    starttimes[r] <- (startclock[r] * 128) + ShiftTime
    
    cat(paste(r, "clock", startclock[r], endclock[r], "\n"))

    ## time of each spike from each cell in record r
    TLast <- -1
    for (cell in 1:NCells) {
      ## spikes for this record and cell.
      spiketimes <- spikes[[((r-1)*NCells)+cell]]
      nspikescell <- length(spiketimes)

      if (nspikescell >0 ) {
        spiketimes <- spiketimes + ShiftTime
        lastspiketime <- spiketimes[nspikescell]
        if ( TLast < lastspiketime)
          TLast <- lastspiketime
      }
      if (r == 1)
        allspikes[cell] <- list(spiketimes)
      else
        allspikes[cell] <- list(c(allspikes[[cell]],spiketimes))
    }

    ## Now check the end time.
    ##cat(paste("before: EndTime", EndTime, "TLast", TLast, "\n"))
    if (EndTime < TLast)
      EndTime <- TLast

    endtimes[r] <- ( (endclock[r]+1)* 128) +
      ((EndTime %/% mm.WrapTime) * mm.WrapTime)

    if (endtimes[r] < EndTime) {
      endtimes[r] <- endtimes[r] + mm.WrapTime
      cat(paste("wraptime added", mm.WrapTime, "\n"))
    }

    EndTime <- endtimes[r]
    
  }                                   #next record.
  
  ## Number of events in each record
  EventsInRecord <- readBin(fp, integer(), NRecords, mm.longsize, endian="big")


  my.num.events <- sum(EventsInRecord)
  if (my.num.events > 0) {
    warning(paste("we have some events... oh oh!", my.num.events, "\n"))
    ## todo: need to read in TE, WE, PE if we have any events.
  }
  TE <- readBin(fp, integer(), my.num.events, mm.longsize, endian="big")
  WE <- readBin(fp, integer(), my.num.events, mm.longsize, endian="big")
  PE <- readBin(fp, integer(), my.num.events, mm.longsize, endian="big")

  ## should now be at the end of the file, so can check file length.

  if ( seek(fp) != filesize)
    stop(paste("difference at end of file", seek(fp), filesize))

  ## End of processing this file.
  close(fp)

  pos <- mm.readpos.compare(NCells, boxes, posfile)
  
  allspikes <- lapply(allspikes, function(x) { x / mm.sample.rate})
  
  ## check that the spikes are monotonic.
  check.spikes.monotonic(allspikes)

  ## Check that the number of spikes matches the number we return in "spikes"
  if (NSpikes != sum(sapply(spikes,length)))
    warning("NSpikes and actual number of spikes differ")
  
  bursts <- lapply(allspikes, function(x) spikes.to.bursts(x, mm.burst.sep))
  
  res <- list (NFiles=NFiles, NBoxes=NBoxes, NRecords = NRecords,
               NSpikes=NSpikes, NEvents=NEvents,
               startclock=startclock, endclock=endclock,
               nevents=NEvents,
               nspikes.rec=nspikes.rec, # #of spikes per record.
               starttimes=starttimes,
               endtimes=endtimes,
               NCells=NCells, boxes=boxes, C=C,
               spikes=allspikes,
               nspikes=sapply(allspikes, length), # #of spikes/cell.
               bursts=bursts,
               T=T,
               ##CrossF=CrossF, CrossR=CrossR, Pe=Pe,
               file=cellname,
               N=N,
               SpikesInRecords=SpikesInRecords,
               SpikesInCell=SpikesInCell,
               pos=pos)
  class(res) <- "mm.s"
  res
}

## ms_funs.r --- General functions for multisite data (both Markus/Rachel's and Jay's)
## Author: Stephen J Eglen
## Copyright: GPL
## Mon 10 Sep 2001

## Functions and variables with "mm" in them are mainly for Markus Meister's
## data; those with "jay" in them are for Jay.  Some functions are suitable
## for both types.

## Some of this code requires code from the tcltk package; this is loaded
## by using the DEPENDS: field in the package description.

plot.mm.s <- function(s, whichcells=NULL,
                      beg=min(unlist(s$spikes), na.rm=TRUE),
                      end=max(unlist(s$spikes), na.rm=TRUE),
                      label.cells = FALSE,
                      show.bursts = FALSE,
                      main=NULL, ylab='spikes of cell',
                      for.figure=FALSE,
                      ...) {
  ## Plot the spikes.
  ## WHICHCELLS is a list of cell numbers to plot; the default is to plot
  ## all of the cells.
  ## BEG and END are the time range for which we want to
  ## plot spikes.  When evaluating maxtime, some cells may have no
  ## spikes; their lists get converted to NA in unlist() so those NA
  ## values need removing.  By default, BEG will be the time of the
  ## first spike, and END will be the time of the last spike.
  ## If SHOW.BURSTS is true, we plots the bursts rather than the spikes.
  ## If LABELS.CELLS is true, we write the cell number of each spike train
  ## in the y-axis.
  ## If FOR.FIGURE is true, we make a slightly different outline, which
  ## is useful for making the figures.

  if (is.null(whichcells)) {
    whichcells <- 1:s$NCells
  }

  if (is.null(main)) {
    main <- basename(s$file)
  }
     
  N <- length(whichcells)
  ticpercell <- 1/N; deltay <- ticpercell * 0.8;
  yminadd <- ticpercell

  if (show.bursts)
    spikes <- s$spikes
  else
    spikes <- s$spikes

  
  if (for.figure) {
    plot( c(beg, end), c(0,1), type='n',
         yaxt="n",
         bty="n",
         main="",
         xaxt="n",
         xaxs="i", yaxs="i",
         xlab="", ylab="", ...)
    mtext(main, side=3, adj=0, line=0.5)
    
  } else {
    plot( c(beg, end), c(0,1), type='n', bty='n',
         yaxt="n", main=main,
         xlab="time (s)", ylab=ylab, ...)
  }
  
  ymin <- 0

  have.bursts <- ( (length(s$allb) > 0) && show.bursts)
  for (cell in whichcells) {
    ts <- spikes[[cell]]                #get spike times.
    n <- length(ts)                     #number of spikes.
    ys <- numeric(n) + ymin
    
    segments(ts, ys, ts, ys+deltay, lwd=0.2) #draw spikes.

    ## simple test to see if bursts have been defined.
    if (have.bursts) {
      burst.times <- s$allb[[cell]]
      if (!is.na(burst.times[1])) {
        ## we have some vald burst info.
        nbursts <- nrow(burst.times)
        ##ys <- rep(ymin+deltay/2, nbursts)

        ## alternate height of bursts so that we can sep adjacent bursts.
        ys <- rep(ymin+deltay/2, nbursts)
        shimmy <- deltay*0.25
        odd <- (1:nbursts) %% 2 == 1
        ys[odd] <- ys[odd] + shimmy

        start.burst <- ts[burst.times[,"beg"]]
        ## for the end of the burst, -1 is needed since if start spike
        ## is 20, and i=3, last spike in burst is 22 (spikes 20, 21, 22)
        end.burst <- ts[ burst.times[,"beg"] + burst.times[,"len"] -1]
        segments(start.burst, ys,
                 end.burst, ys,
                 col="red", lwd=2)
        text(start.burst, rep(ymin+deltay*1.1, nbursts),
             labels=burst.times[,"len"], col="blue")
      }
    }
    ymin <- ymin + yminadd
  }

  if (label.cells) {
    allys <- seq(from=yminadd/2, by=yminadd, length=N)
    mtext(whichcells, side=2, at=allys, las=1)
  }

}

draw.spikes <- function (t, tmin, tmax,
                         ht=1, spike.ht, label, xscale) {

  ## Compulsory args:
  ## T is the set of spike times.
  ## TMIN, TMAX are the min and max times to show.
  ##
  ## HT is the overall ht of the plot.  SPIKE.HT is then the height
  ## of each spike.  (spike.ht should be less than ht.)
  ## LABEL is an optional label to put at the top of each plot.
  ## If XSCALE is given, it should be a vector (lo, hi) indicating the
  ## the scalebar to add -- this is just reusing the x-axis.  Alternatively
  ## if XSCALE is NULL, no scalebar is drawn.
  
  if (missing(spike.ht))
    spike.ht <- 0.7 * ht                #spike ht should be 90% of total ht.


  y.low <- 0.1                          # min y-value, should be [0,1].

  ## throw out spikes outside range [tmin, tmax]
  reject.spikes <-  (t < tmin) | (t > tmax)
  if (any(reject.spikes))
    t <- t[-reject.spikes]
  else
    cat("no spikes outside [tmin,tmax]\n")
  ## set up the plot region, but don't draw any points.
  plot( c(tmin, tmax), c(0, ht),
       bty="n",                         #switch off border
       xlab="", ylab="",                #no labelling of axes.
       xaxt="n", yaxt="n",              #no automatic axes.
       xlim=c(tmin, tmax), ylim=c(0, ht),
       type="n")


  ## We can manually add x and y tics, just for checks...
  if (missing(xscale))
    ## probably don't want xaxis in final version.
    axis(1, at=c(tmin, tmax))             #x-axis
  else {
    ## assume xscale is a 2-d vector providing start and stop time of
    ## scalebar.  tck is the tick length.  labels=FALSE prevents
    ## number labelling of the plot.
    if (!is.null(xscale)) {
      stopifnot(length(xscale)==2)
      axis(1, at=c(xscale[1], xscale[2]), labels=FALSE, tck=0)
    }
  }
  
  ##axis(2, at=c(0, ht))                  #y-axis

  ## for each spike at time t, we draw a line from the point (t,0)
  ## to (t,spike.ht).
  y1 <- y.low + seq(0, by=0, along=t) # vector of zeros, of same length as t.
  y2 <- y1 + spike.ht
  segments(t, y1, t, y2)

  ## optionally label the plot.
  if (!missing(label))
    mtext(label, side=3, adj = 0.02)    #draw label on top axis.
  
}



summary.mm.s <- function(object, ...) {
  cat(paste("Spike data:", object$file, "\n"))
  cat(paste("NCells", object$NCells, "\n"))
}

######################################################################
## Jay's functions.
######################################################################



make.jay.layout <- function(positions) {
  ## make the layout for Jay's MEA


  xlim <- ylim <- c(50, 850)
  spacing <- 100

  cols <- as.integer(substring(positions, 1,1)) * spacing
  rows <- as.integer(substring(positions, 2,2)) * spacing
  pos <- cbind(cols, rows)
  
  rownames(pos) <- positions
  
  layout <- list(xlim=xlim, ylim=ylim, spacing=spacing,
                 pos=pos)

  class(layout) <- "mealayout"

  layout

}

jay.read.spikes <- function(filename, ids=NULL,
                            time.interval=1,
                            beg=NULL, end=NULL,
                            min.rate=0) {
  ## Read in Jay's data set.
  ## IDS is an optional vector of cell numbers that should be analysed
  ## -- the other channels are read in but then ignored.

  fp <- gzfile(file.or.gz(filename), open="r")

  ## todo: in an ideal world, this limit would not be required...
  max.channels <- 200                   #should typically be 64 or less.
  channels <- character(max.channels)
  ## first read in the channel names
  num.channels <- 0
  read.channel.names <- 1
  while(read.channel.names) {
    x<-scan(fp, "", n=1, sep='\t', quiet=TRUE)
    ## If first letter of item is not "c" then assume we have now
    ## reached the timestamps.
    if (tolower(substr(x,1,2)) != "ch") {
      read.channel.names <- 0
      rest <- scan(fp, sep='\t', quiet=TRUE); close(fp)
      ## last element of `rest' is redundant (there is one more TAB that
      ## is not needed at the end of the file), but we need to keep 
      ## x - this is the first element.
      ## File format documented in ~/ms/jay/JAYDATAFORMAT.txt
      times <- c(as.double(x), rest[1:length(rest)-1])
      ntimes <- length(times)
      dim(times) <- c(num.channels, ntimes/num.channels)
      channels <- channels[1:num.channels] #truncate to right size.
      
    } else {
      ## still reading the channel names.
      num.channels <- num.channels + 1
      if (num.channels > max.channels) {
        stop(paste("num.channels has exceeded max.channels"))
      } else {
        channels[num.channels] <- x
      }
    }
  }

  spikes <- apply(times, 1, jay.filter.for.na)

  if (!is.null(end))
    spikes <- lapply(spikes, jay.filter.for.max, max=end)

  if (!is.null(beg))
    spikes <- lapply(spikes, jay.filter.for.min, min=beg)


  
  if (!is.null(ids) ) {
    if (any(ids>length(spikes)))
      stop(paste("some ids not in this data set:",
                 paste(ids[ids>length(spikes)],collapse=" ")))
    
    spikes <- spikes[ids];
    channels <- channels[ids];
  }

  spikes.range <- range(unlist(spikes))
  if (is.null(beg))  beg <-  spikes.range[1]
  if (is.null(end))  end <-  spikes.range[2]
  rec.time <- c(beg, end)
  if (min.rate > 0 ) {
    
    ## Check for inactive channels.
    nspikes <- sapply(spikes,length)
    durn <- diff(rec.time)
    rates <- nspikes/durn
    inactive <- which(rates < min.rate)
    if (any(inactive)) {
      paste("Removing spikes with low firing rates: ",
            paste(inactive, collapse=' '))
      spikes   =   spikes[-inactive]
      channels = channels[-inactive]
    }
    
    
  }


  
  ## Count the number of spikes per channel, and label them.
  nspikes <- sapply(spikes, length)
  names(nspikes) <- channels

  ## meanfiring rate is the number of spikes divided by the (time of
  ## last spike - time of first spike).  
  meanfiringrate <- nspikes/ ( sapply(spikes, max) - sapply(spikes, min))

  ## Parse the channel names to get the cell positions.

  layout <- make.jay.layout( substring(channels, 4, 5))
  
  ## temporary test: shuffle electrode positions.
  ## pos <- pos[sample(1:num.channels),]
  
  ## check that the spikes are monotonic.
  check.spikes.monotonic(spikes)

  rates <- make.spikes.to.frate(spikes, time.interval=time.interval,
                                beg=beg, end=end)
  
  ## See if we need to shift any units.  this affects only the
  ## visualisation of the units in the movies.  We assume that "shifted"
  ## positions are stored in the file with same name as data file
  ## except that the .txt is replaced with .sps.  Then each line of this
  ## file contains three numbers:
  ## c dx dy
  ## where c is the cell number to move, and dx,dy is the amount (in um)
  ## by which to move the cells.  If you edit the file, this function
  ## must be called again for the new values to be read in.
  ## The shifted positions are used only by the movie functions and
  ## by the function plot.shifted.jay.pos(s) [this shows all units].
  shift.filename <- sub("\\.txt(\\.gz)?$", ".sps", filename)
  unit.offsets <- NULL                  #default value.
  if (file.exists(shift.filename)) {
    updates <- scan(shift.filename)
    ## must be 3 data points per line
    stopifnot(length(updates)%%3 == 0)
    updates <- matrix(updates, ncol=3, byrow=TRUE)
    units <- updates[,1]
    if (any(units> length(spikes))) {
      stop(paste("some units not in recording...",
                 paste(units[units>=length(spikes)],collapse=",")))
    }
    unit.offsets <- layout$pos*0               #initialise all elements to zero.
    unit.offsets[units,] <- updates[,2:3]
  }
  
  
  
  res <- list( channels=channels,
              spikes=spikes, nspikes=nspikes, NCells=length(spikes),
              meanfiringrate=meanfiringrate,
              file=filename,
              layout=layout,
              rates=rates,
              rec.time=rec.time,
              unit.offsets=unit.offsets
              )
  class(res) <- "mm.s"

  ## Electrodes are spaced 100um apart in Jay's rectangular array.
  jay.distance.breaks = c(0, 150, 250, 350, 450, 550, 650, 1000)
  res$corr = corr.index(res, jay.distance.breaks)

  res


}

jay.filter.for.na <- function(x) {
  ## Truncate the vector X so that trailing NA entries are removed.
  ## This removes the 'empty' spikes at the bottom of each column when
  ## the .txt file is first read in.
  x.na <- which(is.na(x))
  if (any(x.na))
    x[1:x.na[1]-1]
  else
    x
}

jay.filter.for.max <- function(x, max) {
  ## Any times greater than MAX are removed.
  x.high <- which(x>max)
  if (any(x.high))
    x[1:x.high[1]-1]
  else
    x
}

jay.filter.for.min <- function(x, min) {
  ## Any times less than MIN are removed.
  ## e.g. jay.filter.for.min(c(1,2,3,4), 6) should return "nothing?"
  ## jay.filter.for.min(c(1,2,3,4), 3) returns 3 4
  x.low <- which(x<min)
  if (any(x.low)) 
    x <- x[-x.low]
  x
}

shuffle.spike.times <- function (s, noise.sd) {
  ## Return new copy of s, with spike trains shuffled to add Gaussian noise
  ## with sd of noise.sd and zero mean.
  spikes <- s$spikes

  add.noise <- function(x, my.sd) {
    ## helper function to add Gaussian noise to a spike train.
    n <- length(x)
    x2 <- sort(x + rnorm(n, sd=my.sd))
  }
  spikes2 <- lapply(spikes, add.noise, noise.sd)
  check.spikes.monotonic(spikes2)
  s2 <- s                               #make a copy of s
  s2$spikes <- spikes2
  s2
}


fourplot <- function(s) {
  ## Simple 2x2 summary plot of an "s" structure.
  old.par <- par(no.readonly = TRUE)
  on.exit(par(old.par))
  
  par(mfrow=c(2,2))
  plot(s$layout)                             #show layout of electrodes.
  plot.meanfiringrate(s)
  plot(s)                                 #plot the spikes.

  if(!is.na(s$corr$corr.indexes[1])) {
    plot.corr.index(s)
  }
}


######################################################################
## Mutual information code.
## taken from Dan Butt's 2002 J Neurosci paper.
prob.r <- function(s)  {
  ## Given the distance bins, return the probability of finding
  ## two neurons a distance r apart.
  num.distances <- (s$NCells * (s$NCells - 1))/2

  counts <- table(s$dists.bins[which(upper.tri(s$dists.bins))])
  if (sum(counts) != num.distances)
    stop("sum of counts differs from num.distances",
          sum(counts), num.distances)

  ## turn into probability.
  counts/num.distances
}


## Jay and I discussed what "M" should be.  If we have a pair of spike
## trains with 5 spikes in A and 10 spikes in B, should M be 5*10 or
## just the number of dt's which are less than 4 seconds?  (i.e. the
## value of this.m below.)  It should be the latter we think, since
## otherwise if the two spikes are perfectly correlated but very long,
## there will be many dt's that will be greater than 4 seconds.  Dan's
## figure 1b seems to show that each p(t|r) will sum to 1.0 (taking
## into account the bin size; seems to be around 40 bins per 0.5
## second in the plot).

## So, for a pair of spike trains, we compute the cross-correlogram up
## to 4 seconds, and then normalise the histogram so that it sums to
## 1.  This histogram is then binned according to the distance between
## the cell pair.  We then take the average of all histograms for that
## distance bin to compute the overall p(t|r).

prob.t.cond.r <- function(s, tmax,n.timebins)
{
  ## Return p(t|r) where r is the bin number.
  spikes <- s$spikes
  distance.bins <- s$dists.bins
  n <- s$NCells
  n.distancebins <- length(s$distance.breaks.strings)
  spikepairs <- integer(n.distancebins)
  nhists <- integer(n.distancebins)

  ## Make a matrix to store the histogram for each bin.  Each row
  ## is a histogram for that distance bin.
  allhists <- matrix(0, nrow=n.distancebins, ncol=n.timebins)
  ##dimnames=list("distance bin", "time"))

  hists.rejected <- 0
  ## For each cell pair, compute the histogram of time differences between
  ## spikes, and bin it according to the distance between the cell pair.
  for (a in 1:(n-1)) {
    n.a <- s$nspikes[a]
    for (b in (a+1):n) {
      n.b <- s$nspikes[b]
      bin <- distance.bins[a,b]

      hist <- hist.ab(spikes[[a]], spikes[[b]], tmax, n.timebins)
      this.m <- sum(hist)

      if (this.m > 0) {
        ## include bin only if there were counts.
        hist <- hist / (this.m)        #normalise by number of comparisons.
        allhists[bin,] <- allhists[bin,] + hist
        nhists[bin] <- nhists[bin] + 1
        spikepairs[bin] <- spikepairs[bin] + this.m
      } else {
        hists.rejected <- 1 + hists.rejected
      }
    }
  }

  if(hists.rejected > 0)
    cat(paste(hists.rejected, "histograms rejected from prob.t.cond.r\n"))
  
  if ((hists.rejected + sum(nhists)) != (n*(n-1)/2))
    stop(paste("did we compute enough histograms between cell pairs?",
               sum(nhists), (n*(n-1)/2)))

  ## Compute the average histogram for each distance.
  ## Now take the average of each histogram.  This could be done by matrix
  ## multiplication, but this is also simple.
  ## for (i in 1:n.distancebins) {allhists[i,] <- allhists[i,] / nhists[i]}
  allhists <- allhists / nhists

  list(nhists = nhists,
       allhists = allhists,
       spikepairs = spikepairs,
       m=sum(spikepairs),                             # number of counts.
       tmax=tmax,
       n.timebins=n.timebins
       )
}

prob.t <- function(p.t.cond.r, p.r)  {
  ## Return p(t)
  p.t <- apply(p.t.cond.r, 2, function(x) { drop(x %*% p.r)}) #scalar product
  if (identical(all.equal(sum(p.t),1), FALSE))
    warning("p.t should sum to 1")
  p.t
}



make.mi <- function(s, tmax=4) {
  ## Return the mutual information.
  ## this includes the bias term,
  ## For Dan's example:
  ## m <- 42000; n.t <-400; n.r <- 9
  ## mi.bias <- ( (n.t * n.r) - n.t - n.r + 1) / ( 2 * m * log(2))
  p.r <- prob.r(s)
  l <- prob.t.cond.r(s, tmax, n.timebins=100)
  p.t.cond.r <- l$allhists
  p.t <- prob.t(p.t.cond.r, p.r)

  if (identical(all.equal(sum(abs(apply(p.t.cond.r, 1, sum))),1),FALSE))
    stop("at least one p(t|r) does not sum to 1")

  (mi <- sum(p.r * apply(p.t.cond.r, 1,
                         function(x) { sum(x * my.log2(x/p.t)) })) )
  m <- l$m;
  n.t <- length(p.t)
  n.r <- length(p.r)
  mi.bias <- ( (n.t * n.r) - n.t - n.r + 1) / ( 2 * m * log(2))

  mi <- mi - mi.bias                    # subtract bias.

  res <- list(
              mi=mi,
              mi.bias=mi.bias,
              p.r=p.r,
              p.t.cond.r=p.t.cond.r,
              l=l,
              p.t=p.t)
  res
}

my.log2 <- function(x) {
  ## Take log2(), but change any NaN to 0, since 0log(0) is defined as zero
  ## because x log x -> 0   as x->0.
  res <- log2(x)
  bad <- which(is.infinite(res))
  if (any(bad))
    res[bad] <- 0
  res
}

show.prob.t.r <- function(s,comment="")  {
  ## Show the p(t|r) distributions.
  ## comment is an optional string to add to the plot.
  ## make.mi() must have been done first...

  op <- par(no.readonly = TRUE)
  nbins <- length(s$distance.breaks) -1
  if (nbins == 7)
    par(mfrow=c(4,2))                   # jay
  else 
    par(mfrow=c(4,3))                   # MM
  par(mar=c(4,4,2,2))                   #reduce each margin a bit.
  par(oma=c(1,0,0,0))                   #outer margin, 1 line at bottom.

  
  timebin.tmax <- s$mi$l$tmax;
  timebin.n    <- s$mi$l$n.timebins;
  timebin.wid <- timebin.tmax/timebin.n; timebin.min <- 0
  timebin.times <- seq(from=timebin.min+(timebin.wid/2),by=timebin.wid,
                       length=timebin.n)
  
  for (i in 1:nbins) {
    plot(timebin.times, s$mi$p.t.cond.r[i,],
         ##main=paste(s$file,"r bin",i),
         xlab="time (s)",
         ylab=expression(paste("p(", Delta,"t|r)")),
         main=paste(s$distance.breaks.strings[i], "um, n=",s$mi$l$nhists[i]),
         )
    lines( timebin.times[c(1,timebin.n)], c(1/timebin.n, 1/timebin.n),lty=3)
  }
  plot(timebin.times, s$mi$p.t, main="p(t)",
       xlab="time (s)", ylab="p(t)")
  mtext(paste(s$file, date(), "MI",signif(s$mi$mi,4),comment),side=1,outer=TRUE)

  par(op)                               #restore old params.
}

count.nab <- function(ta, tb, tmax=0.05) {
  ## C routine to count the overlap N_ab (from Wong et al. 1993)
  z <- .C("count_overlap",
          as.double(ta),
          as.integer(length(ta)),
          as.double(tb),
          as.integer(length(tb)),
          as.double(tmax),
          res = integer(1), PACKAGE="sjemea")
  z$res
}

hist.ab <- function(ta, tb, tmax, nbins) {

  ## C routine to bin the overlap time between two spike trains (TA,
  ## TB) into a histogram with NBINS ranging from to TMAX [0,TMAX].
  ## The sign of time differences is ignored.
  z <- .C("bin_overlap",
          as.double(ta),
          as.integer(length(ta)),
          as.double(tb),
          as.integer(length(tb)),
          as.double(tmax),
          res = integer(nbins),
          as.integer(nbins), PACKAGE="sjemea")

  counts <- z$res
  names(counts) <- hist.make.labels(0, tmax, nbins, right=FALSE)
  counts
  
}

histbi.ab <- function(ta, tb, tmax, nbins) {
  ## C routine to bin the overlap time between two spikes into a
  ## histogram up to +/- TMAX.  This is a bidirectional version of
  ## hist.ab, so the sign of time difference matters and the histogram
  ## ranges in [-TMAX,+TMAX]
  
  z <- .C("bin2_overlap",
          as.double(ta),
          as.integer(length(ta)),
          as.double(tb),
          as.integer(length(tb)),
          as.double(tmax),
          res = integer(nbins),
          as.integer(nbins), PACKAGE="sjemea")

  counts <- z$res
  names(counts) <- hist.make.labels(-tmax, tmax, nbins, right=FALSE)
  counts
}

hist.make.labels <- function(tmin, tmax, nbins, right=TRUE) {
  ## Make the labels for the histogram bins.
  ## right=TRUE: Each histogram is of the form
  ## (lo, hi], except for the first bin, which is [lo,hi].
  ##
  ## right=FALSE: Each histogram is of the form
  ## [lo, hi), except for the last bin, which is [lo,hi].
  ## This is an internal function that is used from hist.ab and histbi.ab.
  breaks <- seq(from=tmin, to=tmax, length=nbins+1)
  dig.lab <- 3
  for (dig in dig.lab:12) {
    ch.br <- formatC(breaks, dig = dig, wid = 1)
    if (ok <- all(ch.br[-1] != ch.br[-(nbins+1)])) 
      break
  }
  if (right) {
    ## right closed
    labels <- paste("(", ch.br[-(nbins+1)],",", ch.br[-1], "]",sep="")
    substring(labels[1], 1) <- "["
  } else {
    ## left closed
    labels <- paste("[", ch.br[-(nbins+1)],",", ch.br[-1], ")",sep="")
    substring(labels[nbins], nchar(labels[nbins])) <- "]"
  }

  labels
}



test.histograms.versus.r <- function() {
  ## Test how well my histograms perform against R's binning methods.
  ## Generate some random data points and see how my binning compares to
  ## the binning produced by R's table facility.
  ## If everything goes okay, it should just produce "99" loops.
  ## This is more thorough than the other tests below.
  min.t <- -2.0; max.t <- 2.0; nbins <- 100
  for (i in 1:99) {

    ## Generate some random data.
    r <- rnorm(90000)
    r <- c(r, (numeric(102) + min.t), (numeric(102) + max.t))

    ## In this case, we will assume that all values should fit within the
    ## bounds of the histogram, i.e. we do not need to sort the data.
    
    ## method 1: clip any value outside boundary to boundary value.
    r <- pmin(max.t, pmax(min.t, r))

    ## method 2: reject any value outside boundary.
    ##valid <- which((r >= min.t) & (r <= max.t)); r<- r[valid]

    ## count the number of elements that should be binned.
    count <-  count.nab(c(0), r,max.t)

    ## t1 - table from R.
    t1 <- table(cut(r, breaks=seq(from=min.t,to=max.t, length=(2*nbins)+1),
                    right=FALSE,include.lowest=TRUE))
    t2 <- histbi.ab(c(0), r, tmax=max.t, nbins=2*nbins)
    t3 <- hist.ab(c(0), r,  tmax=max.t, nbins=nbins)


    if(!all.equal.numeric(t1,t2)) {
      print("first test")
      print(t1); print(t2)
      ##error("these are not equal")
    }
      
    if(!all.equal.numeric(sum(t1), count)) {
      print("2nd test")
      print(sum(t1)); print(count)
      ##error("sum and count are unequal")
    }
    bi.cols <- cbind( nbins:1, (nbins+1):(2*nbins))
    bi.sums <- apply(matrix(t2[bi.cols], ncol=2), 1, sum)
    if(!all.equal.numeric(t3, bi.sums)) {
      print("third test")
      print(t3); print(bi.sums)
      ##error("t3 and bi.sums are unequal")
    }
    print(i)
  }
  print("all okay")
}
  
test.hist.ab <- function() {
  ## Test function to check how hist.ab() compares to R's hist/cut().
  ## If we say spike train A has one spike at time 0, the histogram
  ## produced for comparing spike train A, B will be the same as
  ## binning the spike times of B.
  ## Here we want times in [0,1] to be binned into 4 bins.
  a <- c(0)

  ## either generate random data, or test boundary's explicitly.  Here
  ## the crucial test is whether 0.5 falls in bin 2 or 3.

  ## The histograms produced by my C-code are [low,high), i.e. closed
  ## on the left, open on the right.  To get the same behaviour in cut()
  ## we need to right=F.
  b <- c(0.1,0.2, 0.4, 0.5, 0.9)
  ##b <- runif(100)
  h <- hist.ab(a, sort(b), 1.0, 4)
  print(h)
  x <- table(cut(b, breaks=c(0,0.25,0.5,0.75,1.0),right=FALSE,
                 include.lowest=TRUE))

  print(x)
  sum(abs(x-h))                         #should be zero.
  
}

test.count.hist.nab <- function(s) {
  ## For a set of spike trains, check that the C functions
  ## count_overlap and hist_overlap calculate the same values: the
  ## value returned by count_overlap should be the same as the sum of
  ## the histogram returned by hist_overlap.
  spikes <- s$spikes
  
  n <- s$NCells
  dt <- 0.05
  counts <- array(0, dim=c(n,n))
  for ( a in 1:(n-1)) {
    n1 <- s$nspikes[a]
    for (b in (a+1):n) {
      n2 <- s$nspikes[b]
      count <-  count.nab(spikes[[a]], spikes[[b]],dt)
      counts[a,b] <- count
      this.hist <- hist.ab(spikes[[a]], spikes[[b]],dt,5)
      if (sum(this.hist) != count) {
        stop(paste("element", a,b, "count", count,
                   "sum", sum(this.hist)))
      }
    }
  }
  ## return the upper triangular array of counts, just in case you want
  ## to examine it.
  counts
}

test.count.hist2.nab <- function(s) {
  ## For a set of spike trains, check that the C functions
  ## count_overlap and hist_overlap calculate the same values: the
  ## value returned by count_overlap should be the same as the sum of
  ## the histogram returned by hist_overlap.  Furthermore, the
  ## bi_overlap function should be the same.
  
  spikes <- s$spikes
  
  n <- s$NCells
  dt <- 0.05
  nbins <- 10
  counts <- array(0, dim=c(n,n))

  ## which bins go together for the same absolute time delay.
  ## Each column tells you which bins of the bi histogram should be
  ## added to make the one-way histogram.
  bi.cols <- cbind( nbins:1, (nbins+1):(2*nbins))

  for ( a in 1:(n-1)) {
    n1 <- s$nspikes[a]
    for (b in (a+1):n) {
      n2 <- s$nspikes[b]
      count <-  count.nab(spikes[[a]], spikes[[b]],dt)
      counts[a,b] <- count
      this.hist <- hist.ab(spikes[[a]], spikes[[b]],dt,nbins)
      ## when doing the bidirectional, must double the number of bins.
      this.hist.bi <- histbi.ab(spikes[[a]], spikes[[b]],dt,nbins*2)

      ## then work out the sums of the bins that correspond to the
      ## same absolute time differences.  Works only for an even
      ## number of bins.
      bi.sums <- apply(matrix(this.hist.bi[bi.cols], ncol=2), 1, sum)

      ##print(this.hist.bi); print(bi.sums); print(this.hist); stop("stop");

      if (sum(this.hist) != count) {
        stop(paste("element", a,b, "count", count,
                   "sum", sum(this.hist)))
      }
      if (any (this.hist - bi.sums)) {
        print(this.hist)
        print(bi.sums)
        stop(paste("histbi element", a,b, "count", count,
                   "sum", sum(this.hist)))
      }
    }
  }
  ## return the upper triangular array of counts, just in case you want
  ## to examine it.
  ##counts
  NULL
}

check.similarity <- function(s, tmax=0.001) {
  ## Check to see if two cells have similar spike trains.
  ## Check pair-wise to see the incidence of coincident spiking
  ## (within TMAX seconds of each other).
  ## Return an array,. showing for each cell pair:
  ## i, j, count, n.i, n.j, frac

  ## where i,j are the numbers of the cells; count is the raw count of
  ## coincident spikes; n.i, n.j are the number of spikes in those
  ## trains, and frac is the count/min(n.i, n.j)

  n.cells <- s$NCells
  n.comparisons <- (n.cells * (n.cells-1))/2
  results <- matrix(0, nrow = n.comparisons, ncol = 6) #results array.
  result.line <- 1
  for (i in 1:(n.cells-1)) {
    n.i <- s$nspikes[i]
    for (j in (i+1):n.cells) {
      count <- count.nab(s$spikes[[i]], s$spikes[[j]], tmax)
      n.j <- s$nspikes[j]
      frac <- count/ min(c(n.i, n.j))
      results[result.line, ] <- c(i, j, count, n.i, n.j, frac)
      result.line <- 1 + result.line
    }
  }
  colnames(results) <- c("i", "j", "count", "n.i", "n.j", "frac")
  results
}

## Global variable that controls whether the xaxis of the xcorr plot
## is shown.
xcorr.plot.xaxistimes <- FALSE

xcorr.plot <-  function(spikes.a, spikes.b,
                        plot.label='',
                        xcorr.maxt=4, bi= TRUE,
                        nbins=100,
                        show.poisson=TRUE,
                        autocorr=FALSE, page.label= date(),
                        pause=TRUE) {

  ## Produce the cross-correlation of two spike trains, SPIKES.A and SPIKES.B.
  ## PLOT.LABEL is the text to be drawn under the plot.
  ## If BI is true, the histogram is [-XCORR.MAXT, XCORR.MAXT], and we see 
  ## both the negative and positive parts of the correlogram.
  ## page.label is the label to add at the bottom of the page.
  ## To make an autocorrelation, SPIKES.A and SPIKES.B are the same train,
  ## and set AUTOCORR to true.  (For autocorrelation we exclude "self counts",
  ## when a spike is compare to itself.)
  ## If PAUSE is true, during interactive usage, we pause between screenfulls.
  ## (X only, may not work on windows...)
  if (bi) {
    x <- histbi.ab(spikes.a, spikes.b, xcorr.maxt, nbins)
  } else {
    x <-   hist.ab(spikes.a, spikes.b, xcorr.maxt, nbins)
  }
  
  if (autocorr) {
    ## We are doing auto-correlation, so subtract Ncells from zero bin.
    ## This is to stop counting the time from one spike to itself.
    zero.bin <- floor((nbins/2)+1)
    x[zero.bin] <- x[zero.bin] - length(spikes.a)
    if (x[zero.bin] < 0)
      stop(paste("zero.bin cannot be reduced below zero",
                 x[zero.bin], length(spikes.a)))
  }

  
  dt.wid <- (2*xcorr.maxt)/nbins        #width (in seconds) of one bin.

  ## Normalize to spikes/sec, by dividing the bin count by (Numspikes*bin)
  ## where Numspikes is the number of spikes in the train, and bin is the
  ## time width of each bin.  (From the Neuroexplorer manual.)
  ##  In contrast, if "probability" is required, the normalisation is that
  ## bin counts are dvided by the number of spikes in the spike train.
  x <- x/ (length(spikes.a) * dt.wid)

  max.val <- signif(max(x),2)

  ## Poisson rate is simply the mean firing rate of the other cell.
  ## This calculated as the number of spikes divided by (time of last
  ## spike minus time of first spike.)
  nspikes.b <- length(spikes.b)
  poisson.rate <- nspikes.b/ (spikes.b[nspikes.b] - spikes.b[1])
  
  ## Plot the histogram.  type "l" is line, "h" for impulses.
  ## No axes are added here.
  plot(x, ylim=c(0,max.val), type="l",
       bty="n",
       xlab="", ylab="", xaxt="n",yaxt="n")

  ## if we want a y-axis, rather than "max" line...
  want.yaxis <- TRUE
  if (want.yaxis) 
    axis(2, at = c(0, max.val), las=1)
  
  if (show.poisson) {
    lines(c(1, length(x)), c(poisson.rate, poisson.rate), lty=1, col="cyan")
  }
  ## Now annotate the plot with some info.  Plot the info as a central
  ## "tic mark" along the x-axis (which goes from 1 to nbins)
#   axis(1, (nbins/2),
#        labels=c(paste(plot.label,
#          ifelse(want.yaxis, "", paste(" max", max.val)),
#          ##"", signif(poisson.rate,2),
#          sep="")))

  ## put axis at bottom;
  if (xcorr.plot.xaxistimes) {
    axis(1, c(1, nbins/2, nbins), labels=c(-xcorr.maxt, 0, xcorr.maxt))
  } else {
    axis(1, c(1, nbins/2, nbins), labels=FALSE)
  }

  ## put label at top:
  mtext(plot.label, side=3, cex=par()$cex)

 
  screen.layout <- par()$mfg
  if ( identical(all.equal.numeric(screen.layout[1:2], c(1,1)), TRUE))
    ## Output the page label for only the first plot of the page.
    mtext(page.label, side=1,outer=TRUE)

  if ( identical(all.equal.numeric(screen.layout[1:2],
                                   screen.layout[3:4]), TRUE)
      && ( (names(dev.cur()) == "X11") || (names(dev.cur()) == "windows"))
      && pause)
    ## If we are using a display and the last plot has just been shown,
    ## wait for the user to press RETURN before displaying next page.
    readline("Press return to see next page of plots.")

}


xcorr.restricted <- function(s, a, b,
                             tmin, tmax,
                             plot.label=paste(a,b,sep=":"),
                             show.poisson=TRUE,
                             xcorr.maxt=5) {
  ## Compute the cross-correlation just between TMIN and TMAX for two
  ## cells, A and B.  Times are given in seconds.  If TMIN, TMAX
  ## omitted, they default to min,max time respectively.

  if (missing(tmin)) tmin <- min(unlist(s$spikes))
  if (missing(tmax)) tmax <- max(unlist(s$spikes))
  
  ## Instead of plotting, we could just get the result returned to us.
  spikes.a <-s$spikes[[a]]
  spikes.b <-s$spikes[[b]]

  ## remove spikes outside the time range [tmin, tmax]
  rej.a <- which( (spikes.a < tmin) | (spikes.a > tmax))
  if (any(rej.a)) spikes.a <- spikes.a[-rej.a]

  rej.b <- which( (spikes.b < tmin) | (spikes.b > tmax))
  if (any(rej.b)) spikes.b <- spikes.b[-rej.b]

  ## for debugging, just check the range of spikes are as thought.
  ##print(range(spikes.a))
  ##print(range(spikes.b))

  xcorr.plot(spikes.a, spikes.b,
             xcorr.maxt=xcorr.maxt,
             bi=TRUE, plot.label=plot.label,
             nbins=100,
             autocorr=FALSE, pause=FALSE,
             show.poisson=show.poisson,
             page.label="page label")

}

crosscorrplots <- function(s, op.file=NULL, tmax=4, nbins=100,
                           autocorr=FALSE,
                           xcorr.ncols=8, xcorr.nrows=14) {
  ## Show all the cross/auto-correlations for the structure.
  ## OP.FILE is the file to output to; If it ends in ".pdf", a PDF is made,
  ## else a postscript file is made.  If OP.FILE is NULL (the default), output
  ## goes to the screen instead, with a pause after each screenfull.
  ## TMAX (defaults to 4 seconds) is the maximum +/-time; NBINS is the
  ## number of bins.
  ## xcorr.nrows and xcorr.ncols controls the dimensions of the array plot.
  
  xcorr.label <- paste(s$file, date(), "tmax [s]", tmax, "nbins", nbins)

  ## If output file ends in ".pdf", make a pdf, else make a postscript file
  if (is.null(op.file)) {
    op <- par(no.readonly = TRUE)
  }
  else {
    if (any(grep ("\\.pdf$", op.file)))
      pdf(file=op.file, width=8.5, height=11)
    else
      postscript(file=op.file)
  }

  par(oma=c(1,0,0,0), mar=c(1.5,1, 0,0)+0.2, tcl=-0.2, mgp=c(0,0,0))
  par(mfrow=c(xcorr.nrows, xcorr.ncols))

  spikes <- s$spikes

  if (autocorr) {
    ncorrs <- s$NCells;
    cell.comparisons <- cbind( 1:ncorrs, 1:ncorrs, 0)
    breaks <- NULL                      #no gaps in the plots
  } else {
    ## more complicated arrangement for cross-correlation
    d <- s$dists;
    d[lower.tri(d, diag=TRUE)] <- NA
    cellpairs <- which(d>=0, arr.ind=TRUE)
    orders <- order(d[cellpairs])
    d2 <- cbind(cellpairs, d[cellpairs])
    ## Now sort them according to smallest distance first.
    cell.comparisons <- d2[orders,]
    ncorrs <- length(orders);
    ## Use the dists.bins matrix to determine when we need to emit a blank
    ## plot.  This helps in viewing the many plots!
    b <- s$dists.bins;  b[lower.tri(b, diag=TRUE)] <- NA
    breaks <- cumsum(table(b))
  }
  for (n in 1:ncorrs) {
    i <- cell.comparisons[n,1]
    j <- cell.comparisons[n,2]
    d <- cell.comparisons[n,3]
    plot.label <- paste(i, ":", j,
                        if (autocorr) {""} else {paste(" d", d)},
                        sep="")

    xcorr.plot(spikes[[i]], spikes[[j]],
               xcorr.maxt=tmax, bi=TRUE, plot.label=plot.label,
               nbins=nbins,
               autocorr=autocorr,
               page.label=xcorr.label)
    if (any(breaks == n))               #if this is the end of a distance bin
      plot.new()                        #then make a blank plot.
  }
  if (is.null(op.file))
    par(op)
  else
    dev.off()
}

check.spikes.monotonic <- function(spikes) {
  ## Check to see that all spike times are monotonically increasing.
  ## The counting and histogram routines assumes that spike times
  ## are sorted, earliest spikes first.
  ## check.spikes.monotonic( list(c(1,3,5), c(1,5,4)))
  results <- sapply( spikes, function(x) { any(diff(x) <0)})
  if (any(results)) {
    stop(paste("Spikes are not ordered in increasing time",
               paste(which(results),collapse=" "),"\n"))
  }
}
  

spikes.to.bursts <- function(spikes, burst.sep=2) {
  ## Convert spikes to bursts.
  ## burst.sep is the threshold time between spikes for finding bursts.
  ## spikes.to.bursts(c(1,2,3, 7,8, 11,12,13,14, 19,20, 23,24))
  ## Note: this is too simplistic, and probably not applicable to animals
  ## at older ages where the spike firing could be almost continuous.
  f <- which( diff(spikes) > burst.sep) +1
  spikes[c(1,f)]
}

list.to.data.frame <- function(l) {
  ## Convert a list of sublists to a data frame.  Each sublist is assumed
  ## to have the same names; each name forms a column.
  ## list.to.data.frame( list (list(a=3, name="cat", legs=4),
  ##                           list(a=5, name="human", legs=2),
  ##                           list(a=5, name="snake", legs=0)) )
  ## Performs minimal sanity checking.
  ## Master version is in ~/langs/R/list_to_dataframe.R -- edit that version
  ## and then copy back here!!!
  
  if(length(unique(sapply(l, length))) > 1)
    stop("not all list elements are of the same length")
  
  ## Check that the names of each sublist are identical.
  num.sublists <- length(l)
  if (num.sublists > 1) {
    for(i in 2:num.sublists) {
      ## check that sublist 2,3... has same names as sublist 1.
      if (any(!(names(l[[i]]) == names(l[[1]])))) {
        print(names(l[[1]]))
        print(names(l[[i]]))
        stop(paste("different names in sublists", 1,  i))
      }
    }
  }
  names <- names(l[[1]])
  new.list <- list()
  for (num in 1:length(l[[1]])) {
    t <- sapply(l, function(x) {x[[num]]})
    column <- list(t); names(column)[1] <- names[num]
    new.list[[num]] <- column
  }
  d <- data.frame(new.list)
  d
}



######################################################################
# movie-related functions.

make.animated.gif <- function (x, beg=1,
                               end=dim(x$rates$rates)[1],
                               delay=10,
                               output="anim.gif",
                               delete.frames=TRUE) {
  ## THIS FUNCTION IS NOW DEPRECATED -- USE MAKE.MOVIEFRAMES INSTEAD.
  ##
  ## Loop over each frame, making a temporary .pbm (black/white) and
  ## then convert it to a GIF.  Temporary gif file names are written
  ## as /tmp/ms.movNNNNN.gif where NNNNN is the frame number.  The
  ## frame number normally has leading zeros (e.g. 00050 rather than
  ## 50) so that the frames are ordered correctly by the * wildcard
  ## when creating the animated gif.
  ##
  ## DELAY is the delay (an integer) in 100ths of a second.
  ## WARNING: this works only on Linux, as it requires a ocuple of
  ## external unix programs.!

  stopifnot(.Platform$OS.type=="unix")
  for (i in beg:end) {
    plot.rate.mslayout(x, i)
    file <- paste("/tmp/ms.mov", formatC(i,width=5,flag="0"), ".gif", sep='')
    dev2bitmap(file="/tmp/ms.mov.pbm", type="pbmraw")
    system(paste("ppmtogif /tmp/ms.mov.pbm >",file, sep=''), ignore.stderr=TRUE)
    ##file <- paste("/tmp/ms.mov", formatC(i,width=5,flag="0"), ".pbm", sep='')
    ##dev2bitmap(file=file, type="pbmraw")
  }

  ## now make the animated gif.
  system(paste("gifsicle --delay=",delay," --loop /tmp/ms.mov*.gif > ",
               output, sep=''))

  ## Have the option to keep or delete the individual frames after
  ## making the movie.

  if (delete.frames)
    system("rm -f /tmp/ms.mov*.gif /tmp/ms.mov.pbm")

}

make.movieframes <- function (x, beg=1,
                               end=dim(x$rates$rates)[1],
                              outputdir=dirname(tempfile()),
                              prefix="mea",
                              show.frames = interactive(),
                              seconds=TRUE,
                              delete.first=FALSE,
                              anim.delay=0) {

  ## Loop over each frame, making a PNG (mono) file.
  ## The frame number normally has leading zeros (e.g. 00050 rather than
  ## 50) so that the frames are ordered correctly by the * wildcard.
  ## OUTPUTDIR is the directory where the files are to be stored.  This
  ## should not end in a forward slash (/).
  ## If DELETE.FIRST is true, we delete all the png files in the output
  ## directory before making any new images.
  ## If SECONDS is true, beg,end are interpreted as time in seconds,
  ## not frames.  These times are then first converted into frame numbers.
  ##
  ## If SHOW.FRAMES is true, we view the frames on the screen as well as
  ## writing them to PNGs.
  ##
  ## Once the frames are made, quicktime on PC can then make a movie of these
  ## frames; or on unix, try: "animate -delay 5 mea*png"
  ##
  ## On unix, we can also use "convert" to make the movies
  ## automatically.  WE can do this by setting ANIM.DELAY to the delay
  ## (in 1/100ths of a second) required between frames.
  
  
  if (substring(outputdir, first=nchar(outputdir))=="/")
    stop(paste("outputdir should not end in slash", outputdir))

  if (seconds) {
    ## convert beg, end into frames.
    beg <- time.to.frame(x$rates$times, beg)
    end <- time.to.frame(x$rates$times, end)
  }
  
  if (delete.first) {
    ## Delete all movie files before making new set.  Best not to use
    ## unlink as it doesn't accept wildcards on DOS.
    files <- list.files(path=outputdir, full.names=TRUE,
                        pattern=paste(prefix,".*\\.png",sep=''))
    if (length(files)>0)
      file.remove(files)
  }


  if (show.frames) {
    ## Show frames on screen whilst also copying them to file.
    ## This may require ghostscript to be installed.
    for (i in beg:end) {
      plot.rate.mslayout(x, i)
      file <- paste(outputdir, "/", prefix,
                    formatC(i,width=5,flag="0"),
                    ".png", sep='')
      ##".ppm", sep='')
      ## Depending on whether we are colour coding or radius coding, change
      ## the device -- this will keep the files small.
      dev2bitmap(file=file, type=ifelse(plot.rate.colour, "pnggray", "pngmono"))
      ##dev2bitmap(file=file, type=ifelse(plot.rate.colour, "pnggray", "ppm"))
    }
  } else {
    ## Do not show frames interactively...
    for (i in beg:end) {
      file <- paste(outputdir, "/", prefix,
                    formatC(i,width=5,flag="0"),
                    ".png", sep='')
      png(file)
      plot.rate.mslayout(x, i)
      dev.off()
      ##dev2bitmap(file=file, type=ifelse(plot.rate.colour, "pnggray", "pngmono"))
    }
  }

  if (anim.delay > 0) {
    ## We want to make an animation...
    cmd = sprintf("cd %s; convert -delay %d %s*png mea.gif",
      outputdir, anim.delay, prefix)
    ##browser()
    system(cmd)
  }
  cat(paste("Movie frames stored in", outputdir, "\n"))
}

time.to.frame <- function(times, time) {
  ## Given a vector of TIMES, return the index closest to TIME.
  ## Normally, times will be the vector s$rates$times.
  which.min(abs(times-time))
}

centre.of.mass <- function(s, beg, end, seconds=TRUE,
                           thresh.num=3, thresh.rate=2) {
  ## Find the centre of mass for a set of spikes.

  ## BEG and END are given in seconds (by default), and converted
  ## into frame numbers here. 
  ## A unit is active if its firing rate is above thresh.rate (Hz).
  ## THRESH.NUM is the minimum number of units that must be active to
  ## draw the Centre of mass.
  ##
  ## We return a list with components:
  ## COM -- a 2-d array giving the centre of mass at each timestep
  ## ACTIVE -- list of units that are active.
  ## METHOD -- the method used to compute CoM.

  first.frame <- 
    if (missing(beg)) 1
    else
      if (seconds)
        time.to.frame(s$rates$times, beg)
      else
        beg
  
  last.frame <-
    if (missing(end)) length(s$rates$times)
    else
      if (seconds)
        time.to.frame(s$rates$times, end)
      else
        end

  n.frames <- (last.frame+1 - first.frame)
  com <- array(NA, dim=c(n.frames,2))   #(x,y) coords of COM for each frame.

  rownames(com) <- s$rates$times[first.frame:last.frame]
  colnames(com) <- c("com x", "com y")
  index <- 1
  active <- real(0)                     #vector of units that are active.

  for (f in first.frame:last.frame) {
    above <- which(s$rates$rates[f,] > thresh.rate)
    if (length(above) >= thresh.num) {
      com[index,] <- c( mean(s$layout$pos[above,1]), mean(s$layout$pos[above,2]))
      active <- sort(union(active, above))
    }
    index <- index+1
  }

  res <- list(com=com, active=active, method="thresh")
  class(res) <- "mscom"
  res
}

centre.of.mass.wt <- function(s, beg, end, seconds=TRUE) {

  ## Find the centre of mass for a set of spikes.
  ## Try a weighting factor version.  All cells included.

  ## BEG and END are given in seconds (by default), and converted
  ## into frame numbers here.
  ## Each unit is weighted by dividing its current firing rate
  ## by the overall firing rate.
  ##
  ## We return a list with two components:
  ## COM -- a 2-d array giving the centre of mass at each timestep
  ## ACTIVE -- list of units that are active.
  ## METHOD -- the method used to compute CoM.
  
  first.frame <- 
    if (missing(beg)) 1
    else
      if (seconds)
        time.to.frame(s$rates$times, beg)
      else
        beg
  
  last.frame <-
    if (missing(end)) length(s$rates$times)
    else
      if (seconds)
        time.to.frame(s$rates$times, end)
      else
        end

  n.frames <- (last.frame+1 - first.frame)
  com <- array(NA, dim=c(n.frames,2))   #(x,y) coords of COM for each frame.

  rownames(com) <- s$rates$times[first.frame:last.frame]
  colnames(com) <- c("com x", "com y")
  index <- 1

  for (f in first.frame:last.frame) {
    ## weighting factor of each unit i.
    mass.i <- s$rates$rates[f,] / s$meanfiringrate
    mass <- sum(mass.i)
    com[index, 1] <- sum( mass.i * s$layout$pos[,1]) / mass
    com[index, 2] <- sum( mass.i * s$layout$pos[,2]) / mass
    index <- index+1
  }

  res <- list(com=com, active=NULL, method="wt by mean")
  class(res) <- "mscom"
  res
}

centre.of.mass.wt2 <- function(s, beg, end, seconds=TRUE,
                               thresh.num=3, thresh.rate=5) {

  ## Find the centre of mass for a set of spikes.
  ## Try a weighting factor version, after we first threshold the units
  ## by the number of cells above a firing rate.
  ## BEG and END are given in seconds (by default), and converted
  ## into frame numbers here.
  ## Each unit is weighted by dividing its current firing rate
  ## by the overall firing rate.
  ##
  ## We return a list with two components:
  ## COM -- a 2-d array giving the centre of mass at each timestep
  ## ACTIVE -- list of units that are active.
  ## METHOD -- the method used to compute CoM.
  
  first.frame <- 
    if (missing(beg)) 1
    else
      if (seconds)
        time.to.frame(s$rates$times, beg)
      else
        beg
  
  last.frame <-
    if (missing(end)) length(s$rates$times)
    else
      if (seconds)
        time.to.frame(s$rates$times, end)
      else
        end

  n.frames <- (last.frame+1 - first.frame)
  com <- array(NA, dim=c(n.frames,2))   #(x,y) coords of COM for each frame.

  rownames(com) <- s$rates$times[first.frame:last.frame]
  colnames(com) <- c("com x", "com y")
  index <- 1

  for (f in first.frame:last.frame) {
    above <- which(s$rates$rates[f,] > thresh.rate)
    if (length(above) >= thresh.num) {
      ## weighting factor of each unit i.
      mass.i <- s$rates$rates[f,] / s$meanfiringrate
      mass <- sum(mass.i)
      com[index, 1] <- sum( mass.i * s$layout$pos[,1]) / mass
      com[index, 2] <- sum( mass.i * s$layout$pos[,2]) / mass
    }
    index <- index+1
  }

  res <- list(com=com, active=NULL, method="wt by mean")
  class(res) <- "mscom"
  res
}

colour.com <- function(com) {
  ## Helper routine to parse the Centre of Mass into consecutive periods
  ## of activity.  This function returns a vector labelling each time-step
  ## of the centre of mass to a wave number.
  nrows <- dim(com)[1]
  colours <- integer(nrows)
  wave <- 0
  in.wave <- FALSE
  for (i in 1:nrows) {
    current <- com[i,1]
    if (in.wave) {
      if (is.na(current)) {
        ## wave has ended
        in.wave <- FALSE
        colour <- NA
      } else {
        ## still within the wave
        colour <- wave
      }
    } else {
      ## see if we are now in a wave.
      if (is.na(current)) {
        colour <- NA
      } else {
        ## new wave has started.
        wave <- wave + 1
        colour <- wave
        in.wave <- TRUE
      }
    }
    colours[i] <- colour
  }

  colours
}

plot.mscom <- function(x, s, colour=TRUE, show.title=TRUE,
                       label.cells=NULL,
                       ##border=FALSE,
                       max.cols=8,
                       rel.cex=1, ...) {
  ## Plot the centre-of-mass using COLOUR if TRUE.
  ## S is optional, but if given, we get to see electrode positions
  ## and the name of the file.
  par.pty <- par()$pty
  par(pty="s")                          #use square plotting region.
  
  if (colour) {
    colours <- colour.com(x$com)
    nwaves <- max(colours, na.rm=TRUE)
    
    ## Break up the COM into "waves", consecutive times when we have
    ## the Centre of Mass. We then loop over these to plot with a
    ## different colour for each wave.
    ##com.lines <- sapply(1:nwaves, function(i) {x$com[which(colours==i),1:2]})
    com.lines <- lapply(1:nwaves, function(i) {
      valid <- which(colours==i)
      v <- x$com[valid,1:2]
      ##matrix(data=v, ncol=2)
    })
    col.num <- 0;
    first.plot <- TRUE

    for (i in 1:nwaves) {
      c <- com.lines[[i]]
      if (is.null((dim(c))))
        next
      else {
        col.num <- col.num +1;
        if (col.num >= max.cols) col.num <- 1;
      }
      if (first.plot) {
        times <- rownames(x$com)
        title <- paste(ifelse(missing(s), "unknown file", basename(s$file)),
                       x$method,
                       times[1], times[length(times)])
        first.plot <- FALSE
        plot(c, xlab="", ylab="",
             xlim = s$layout$xlim,
             ylim = s$layout$ylim,
             xaxt="n", yaxt="n",
             col=col.num, asp=1, type="l",
             main=ifelse(show.title,title,""))
      } else {
        lines(c, col=col.num)
      }
      ##text(c[1,1], c[1,2], "*", cex=3*rel.cex)
      ## Draw the starting point and add a bit of jitter.
      text(c[1,1]+(20*runif(1)), c[1,2]+(20*runif(1)), "*",
           col=col.num, cex=3*rel.cex)
    }
    ## draw electrode positions if we have them.
    if(!missing(s)) {
      ## if we don't have active list, just draw them all as empty.
      electrode.cols <- rep(0, dim(s$layout$pos)[1]) #default colour of white.
      if (!is.null(x$active))
        electrode.cols[x$active] <- 1   #black for the active ones.

      points(s$layout$pos, pch=21, bg=electrode.cols, cex=rel.cex*0.9,
             lwd=0.4)
    }
    if (!is.null(label.cells)) {
      text(as.numeric(label.cells[,1]),
           as.numeric(label.cells[,2]),
           labels=label.cells[,3], cex=rel.cex*1)
    }

  } else {
    ## let's not bother with colours.
    plot.default(x$com, type="b",asp=1)
  }

  ## restore "pty" parameter.
  par(pty=par.pty)        
}
  

show.movie <- function(x, beg=1, end,
                       seconds=TRUE,
                       delay=0.03, ...) {
  ## Show a movie within R.
  ## x is the spikes data structure.
  ## BEG is the number of the first frame.
  ## END is the number of the last frame (defaults to the number of
  ## frames to show).
  ## If seconds is true, BEG and END are taken to be time in seconds, rather
  ## than frame numbers.  These are then converted into frame numbers.
  ## delay gives the delay in seconds between frames.
  if (seconds) {
    beg <- time.to.frame(x$rates$times, beg)
    if (missing(end))
      end <- dim(x$rates$rates)[1]
    else
      end <- time.to.frame(x$rates$times, end)
  } else {
    if (missing(end))
      end <- dim(x$rates$rates)[1]
  }
       
  for (f in beg:end) {
    plot.rate.mslayout(x, f, ...)
    Sys.sleep(delay)
  }
}


make.spikes.to.frate <- function(spikes,
                                 time.interval=1, #time bin of 1sec.
                                 frate.min=0,
                                 frate.max=20,
                                 clip=FALSE,
                                 beg=floor(min(unlist(spikes))),
                                 end=ceiling(max(unlist(spikes)))
                                 ) {
  ## Convert the spikes for each cell into a firing rate (in Hz)
  ## We count the number of spikes within time bins of duration
  ## time.interval (measured in seconds).
  ##
  ## Currently cannot specify BEG or END as less than the
  ## range of spike times else you get an error from hist().  The
  ## default anyway is to do all the spikes within a data file.

  ## if clips is set to TRUE, firing rate is clipped within the
  ## values frate.min and frate.max.  This is problably not needed.

  spikes.to.rates <- function(spikes, breaks, time.interval) {
    ## helper function.
    h <- hist(spikes, breaks=breaks,plot=FALSE)
    h$counts/time.interval                #convert to firing rate (in Hz)
  }
  time.breaks <- seq(from=beg, to=end, by=time.interval)
  if (time.breaks[length(time.breaks)] < end) {
    ## extra time bin needs adding.
    ## e.g seq(1,6, by = 3) == 1 4, so we need to add 7 ourselves.
    time.breaks <- c(time.breaks,
                     time.breaks[length(time.breaks)]+time.interval)
  }
  rates1 <- lapply(spikes, spikes.to.rates, breaks=time.breaks,
                   time.interval=time.interval)

  ## rates1 is a list; we want to convert it into an array.
  rates <- array(unlist(rates1),
                  dim=c(length(time.breaks)-1, length(rates1)))

  ## Now optionally set the upper and lower frame rates if clip is TRUE.
  if (clip)
    rates <- pmin(pmax(rates, frate.min), frate.max)


  ## Do the average computation here.
  ## av.rate == average rate across the array.
  av.rate <- apply(rates, 1, mean)
  ## We can remove the last "time.break" since it does not correspond
  ## to the start of a time frame.
  res <- list(rates=rates,
              times=time.breaks[-length(time.breaks)],
              av.rate=av.rate,
              time.interval=time.interval)
  res
}

plot.meanfiringrate <- function (s, beg, end, main=NULL, ...) {
  ## Plot the mean firing rate over all the cells at each time step.
  ## Can optionally specify the beginning (BEG) and end (END) time, in
  ## seconds.
  
  if (missing(beg)) beg <- s$rates$times[1]
  if (missing(end)) end <- s$rates$times[length(s$rates$times)]

  if (is.null(main))
    main = basename(s$file)
  
  plot(s$rates$times, s$rates$av.rate, type = "h", xlab = "time (s)",
       xlim=c(beg,end), bty="n", lwd=0.2,
       ylab = "mean firing rate (Hz)", main = main, ...)
}

"setrates<-" <- function(s, value) {
  ## set the $rates and $times field of jay's structures.
  ## typical usage:
  ## rates <- make.spikes.to.frate(js, ...)
  ## setrates(js) <- rates
  
  s$rates$rates <- value$rates
  s$rates$times <- value$times
  s
}


## Simple statistics of the spike trains.

fano.array <- function(spikes, fano.timebins=c(0.1, 1.0)) {
  ## Compute fano factor for set of spike trains over a range of
  ## time bins.
  stopifnot(is.list(spikes))
  a <- sapply(fano.timebins, function(t) { fano.allspikes(spikes, t)})
  rownames(a) <- 1:length(spikes)
  colnames(a) <- fano.timebins
  a
}

fano.allspikes <- function(spikes, timebin) {
  ## helper function to compute fano factor of all spike trains
  ## for one time bin.
  sapply(spikes, function(x) {fano(x, timebin)[4]})
}

fano <- function(spikes, bin.wid=0.1) {
  ## Compute the fano factor for one spike train, and for one bin width.

  ## When computing breaks, sometimes the last break comes before the
  ## last spike time, in which case we remove the spikes that come
  ## after the last break.  This should remove only a very small
  ## number of spikes.
  breaks <- seq(from=0, to=ceiling(max(spikes)), by=bin.wid)
  last.break <- breaks[length(breaks)]
  spikes <- spikes[which( spikes <= last.break)]

  h <-  hist(spikes,
             breaks=breaks,
             plot=FALSE, include.lowest=TRUE)

  counts <- h$counts
  counts.mean <- mean(counts); counts.var <- var(counts)
  counts.fano <- counts.var / counts.mean
  res <- c(bin.wid, counts.var, counts.mean, counts.fano)
  names(res) <- c("bin wid", "var", "mean", "fano")
  res
}

fano.plot <- function(s, fano.timebins=c(0.05, 0.1, 1.0, 2.0)) {
  ## Box plot showing fano factor for the group of units
  ## as a function of the time bin used for the Fano factor.
  f <- fano.array(s$spikes, fano.timebins=fano.timebins)
  boxplot(as.data.frame(f),
          main=s$file,
          xlab="time bin(s)", ylab="fano factor")
  curve((x*0)+1,add=TRUE)                        #Poisson line x=1

  ## Return the fano array for subsequent processing.
  f
}


isi <- function(train) {
  ## Compute the ISI for one spike train.
  n <- length(train)
  if (n>1) {
    isi <- diff(train)
  } else {
    isi <- NA                           #cannot compute ISI with 0 or 1 spike.
  }
  isi
}

cv.isi <- function(train) {
  ## Given a spike train, compute the CV.ISI.
  n = length(train)
  if ( n >1) {
    isi = diff(train)
    isi.mean = mean(isi)
    isi.sd = sd(isi)
    cv = isi.sd / isi.mean
  } else {
    cv = NA                     #cannot compute ISI with 0 or 1 spike.
  }
  cv
}
  

plot.cumisi <- function(s, xlim=c(0.01, 30)) {

  ## Show the ISI cumulative historgrams.
  ## Each black line is ISI from one channel.
  ## Red line is the mean ISI across the whole array...
  
  show.isi.cdf <- function(spikes, col='black',lwd=1) {
    if (length(spikes)>1) {
      isi1 <- isi(spikes)
      s <- sort(isi1)
      n <- length(s)
      y <- (1:n)/n
      lines(s, y, col=col,lwd=lwd)
    }
  }

  plot(NA, NA, log='x', xlim=xlim, ylim=c(0,1),
       xlab='ISI (s)', ylab='cumulative probability', type='n', bty='n')

  title(basename(s$file))
  res <- sapply(s$spikes, show.isi.cdf)

  ## This is a hacky way to get the average -- since "tt" will be very long...
  tt <- unlist(s$spikes)
  show.isi.cdf(tt, col='red', lwd=2)

  ## Other ideas for plotting the ISI histogram
  ##x = density(isi1)
  ## plot(x, log='x')
  ##x = hist(isi1, breaks=100)
  
}



## store the maximum and minimum firing rate.  Any firing rate bigger
## than this value is set to this value; this prevents the circles
## from overlapping on the plots.  Likewise, anything smaller than the
## minimum is set to the minimum value.
jay.ms.max.firingrate <- 10
jay.ms.min.firingrate <- 0.0                  #min firing rate in Hz.

## if electrodes are 100um, each circle can be no bigger than 50um radius,
## else they will overlap.

jay.ms.max.rad <- 50                    #radius for highest firing rate.
jay.ms.min.rad <- 2                     #size of smallest rate.


rates.to.radii <- function(rates) {
  rates.to.radii.prop.rad(rates)
}

rates.to.radii.prop.rad <- function(rates) {
  ## Convert the firing rates RATES into radii, such that radius
  ## is proportional to firing rate.

  ## first ensure rates bounded in [min,max]
  rates <- pmax(pmin(rates,jay.ms.max.firingrate),
                jay.ms.min.firingrate)
  
  radii <- jay.ms.min.rad +
    ((jay.ms.max.rad - jay.ms.min.rad)* ( rates - jay.ms.min.firingrate) /
     (jay.ms.max.firingrate - jay.ms.min.firingrate))

  radii
}

rates.to.radii.prop.area <- function(rates) {
  ## Convert the firing rates RATES into radii, such that area of circle
  ## is proportional to firing rate.
  
  ## first ensure rates bounded in [min,max]
  rates <- pmax(pmin(rates,jay.ms.max.firingrate),
                jay.ms.min.firingrate)

  min.area <- pi * (jay.ms.min.rad^2)
  max.area <- pi * (jay.ms.max.rad^2)
  area <- min.area +
    ((max.area - min.area)* ( rates - jay.ms.min.firingrate) /
     (jay.ms.max.firingrate - jay.ms.min.firingrate))

  radii <- sqrt(area/pi)

  radii
}

## To compare the effect of the two different methods for converting
## rate to radius:
##
##rates <- seq(from=jay.ms.min.firingrate,to=jay.ms.max.firingrate, length=100)
##plot(rates, rates.to.radii.prop.area(rates), type="l",
##     xlab="rate (Hz)", ylab="radius (um)")
##points(rates, rates.to.radii.prop.rad(rates),pch=19)

## set to TRUE for colour coding of firing rate; FALSE for radius-encoding.
## Colour-coding seems to flicker a lot more than radius coding...
plot.rate.colour <- FALSE


plot.rate.mslayout <- function(...) {
  ## Simple wrapper to decide whether to encode firing rate as a radius or
  ## colour of circle.
  if (plot.rate.colour)
    plot.rate.mslayout.col(...)
  else
    plot.rate.mslayout.rad(...)
}

plot.rate.mslayout.rad <- function(s, frame.num, show.com=FALSE,
                                   show.time=TRUE,
                                   skip.empty=FALSE) {
  ## New version, fixed for Jay's dimensions.
  ## Plot the given frame number in the multisite layout.
  ## The biggest character size is set by jay.ms.max.firingrate.
  ## If SHOW.COM is true, we show the centre of mass as a green dot.
  ## If SKIP.EMPTY is true, any frames where all circles are at min radius
  ## are not drawn.
  ## If SHOW.TIME is true, write the current time above the plot.
  no.small.dots <- FALSE;               #set this to TRUE/FALSE

  radii <-  rates.to.radii(s$rates$rates[frame.num,])
  
  ## If the radius is zero, R (on unix) still draws a v. small circle
  ## -- is this a bug?  Anyway, replacing zeros (or small values)
  ## with NAs does the trick if you don't want small circles (but they
  ## act as electrode positions which is handy).

  ## extract the unit positions and optionally update them to account
  ## for offsets, so that cells do not overlap on screen.
  xs <- s$layout$pos[,1]; ys <- s$layout$pos[,2]
  if (!is.null(s$unit.offsets)) {
    xs <- xs + s$unit.offsets[,1]
    ys <- ys + s$unit.offsets[,2]
  }

  draw.anything <- TRUE                 #flag - do not change.
  
  if (no.small.dots) {
    min.radius <- jay.ms.min.firingrate *jay.ms.max.rad / jay.ms.max.firingrate
    small.cells <- which(radii < min.radius)
    if (any(small.cells))
      radii[small.cells] <- NA

    if (length(small.cells) == s$NCells) {
      ## nothing to draw.
      draw.anything <- FALSE
    }
      
  }

  if (draw.anything) {
    if (!skip.empty || (any(radii > jay.ms.min.rad))) {
      symbols(xs, ys,
              fg="black", bg="black",
              circles=radii,
              xaxt="n", yaxt="n", xlab='', ylab='',
              inches=FALSE,
              xlim=s$layout$xlim, ylim=s$layout$ylim,
              main=ifelse(show.time,
                formatC(s$rates$times[frame.num], digits=1, format="f"),
                "")
              )
      if (show.com) {
        com <- centre.of.mass(s, frame.num, frame.num, seconds=FALSE)
        if(any(com$active))
          ## for retreat, colour them green.
          ##points(com$com, pch=19, col="green")
          ##points(com$com, pch=21, lwd=0.5, bg="grey")
          ## use a triangle for COM, so distinct from open circles
          ## used in other centre of mass plots.
          points(com$com, pch=23, lwd=0.5, bg="white")
      }
    }
  } else {
    ## nothing to draw, so just draw outline.
    if (draw.empty) 
      plot( NA, NA,
           xaxt="n", yaxt="n", xlab='', ylab='',
           xlim=s$layout$xlim, ylim=s$layout$ylim,
           main=formatC(s$rates$times[frame.num], digits=1, format="f"))
  }
}

## Number of colours to have in the firing rate colourmap
## +the colourmap itself.  Reverse the list so that white is low
## and black is high.
jay.ms.ncols <- 16
jay.ms.cmap <- rev(gray(0:(jay.ms.ncols-1)/(jay.ms.ncols-1)))

plot.rate.mslayout.col <- function(s, frame.num, show.com=FALSE,
                                   skip.empty=F) {
  ## Colour indicates firing rate.
  ## Plot the given frame number in the multisite layout.
  ## If SHOW.COM is true, we show the centre of mass as a green dot.
  ## If SKIP.EMPTY is true, any frames where all circles are at min radius
  ## are not drawn.

  ## This time, radii are fixed size (e.g. 45um), but colour varies.
  ## radii <- rep(jay.ms.max.rad, dim(s$layout$pos)[1])
  radii <- rep(45, dim(s$layout$pos)[1])

  cols <- rates.to.cols(s$rates$rates[frame.num,])

  ## extract the unit positions and optionally update them to account
  ## for offsets, so that cells do not overlap on screen.
  xs <- s$layout$pos[,1]; ys <- s$layout$pos[,2]
  if (!is.null(s$unit.offsets)) {
    xs <- xs + s$unit.offsets[,1]
    ys <- ys + s$unit.offsets[,2]
  }

  symbols(xs, ys,
          fg="black",
          bg=jay.ms.cmap[cols],
          bty="n",
          circles=radii,
          xaxt="n", yaxt="n", xlab='', ylab='',
          inches=FALSE,
          xlim=s$layout$xlim, ylim=s$layout$ylim,
          main=formatC(s$rates$times[frame.num], digits=1, format="f"))
  if (show.com) {
    com <- centre.of.mass(s, frame.num, frame.num, seconds=FALSE)
    if(any(com$active))
      points(com$com, pch=19, col="green")
  }
}

rates.to.cols <- function(rates) {
  bin.wid <- (jay.ms.max.firingrate - jay.ms.min.firingrate) /
    jay.ms.ncols
  
  cols <- floor( (rates-jay.ms.min.firingrate)/ bin.wid)+1
  ## in case firing rate is outside range of firingrates, limit values
  ## of cols to within 1:jay.ms.ncols.
  cols <- pmax(cols, 1)                 
  cols <- pmin(cols, jay.ms.ncols)
}

plot.rate.mslayout.scale <- function(s) {
  ## Draw the scale bar for the plots.

  if (plot.rate.colour) {
    x <- seq(from=100, to=700, by=100)
    y <- rep(500, length(x))
    rates <- seq(from=jay.ms.min.firingrate, to=jay.ms.max.firingrate,
                 length=length(x))
    radii <- rep(45, length(x))
    cols <- rates.to.cols(rates)
    
    symbols(x, y,
            fg="black",
            bg=jay.ms.cmap[cols],
            circles=radii,
            xaxt="n", yaxt="n", xlab='', ylab='',
            inches=FALSE,
            xlim=s$layout$xlim, ylim=s$layout$ylim,
            main="legend")
  } else {
    ## show the radius scale bar.
    x <- seq(from=100, to=700, by=100)
    y <- rep(500, length(x))
    rates <- seq(from=jay.ms.min.firingrate, to=jay.ms.max.firingrate,
                 length=length(x))
    radii <-  rates.to.radii(rates)
    
    symbols( x, y,
            fg="black", bg="black",
            circles=radii,
            xaxt="n", yaxt="n", xlab='', ylab='',
            inches=FALSE,
            xlim=s$layout$xlim, ylim=s$layout$ylim,
            main="legend")
  }
  text(x, y-200, labels=signif(rates,digits=2),cex=0.5)

}

movie.postage <- function(s, tmin, tmax, file="movies.ps") {
  ## Create a postscript file of the firing rate from TMIN to TMAX (given in
  ## seconds).
  postscript(file=file)
  par(mfrow=c(5, 7))
  par(oma=c(0,0,3,0)); par(mar=c(0,1,3,0))
  par(pty="s")                            #produce a square plotting region.
  show.movie(s, seconds=TRUE, delay=0,
             beg=tmin, end=tmax,
             show.com=TRUE, skip.empty=TRUE)
  plot.rate.mslayout.scale(s)
  dev.off()
}

plot.rate.mslayout.old <- function(s, frame.num) {
  ## Plot the given frame number in the multisite layout.
  ## If you want to plot circles rather than disks, change "pch=19"
  ## to "pch=21".  Do `help("points")' for a summary of plot types.
  ## The biggest character size is set by jay.ms.max.firingrate.
  ## xaxt and yaxt control whether or not the axes are plotted.
  
  plot(s$layout$pos[,1], s$layout$pos[,2], pch=19, xaxt="n", yaxt="n",
       cex=pmin(s$rates$rates[frame.num,],jay.ms.max.firingrate),
       xlab='', ylab='',
       main=formatC(s$rates$times[frame.num], digits=1, format="f"))
}



op.picture <- function(pos, rates, iteration) {
  ## output a plot of the multisite array activity as a postscript file.
  ps.scale <- 0.5 ### 1.0                      #overall scale factor for plot.
  
  ps.min.x <- 40; ps.min.y <- 40
  ps.wid <-  560 * ps.scale; ps.ht <- 560 * ps.scale;
  ps.max.x <- ps.min.x + ps.wid
  ps.max.y <- ps.min.y + ps.ht
  ps.centre.x <- 0.5 * (ps.min.x + ps.max.x)
  ps.centre.y <- 0.5 * (ps.min.y + ps.max.y)
  

  ps.header <- paste("%!PS-Adobe-3.0 EPSF-3.0\n",
                     "%%Title: Main canvas\n",
                     "%%BoundingBox: ", ps.min.x, " ", ps.min.y, " ",
                     ps.max.x, " ", ps.max.y, "\n",
                     "%%CreationDate: ", date(), "\n",
                     "%%EndComments\n\n",
                     ##"%% /d { 3 1 roll   moveto 10.0 div drawbox} def\n\n",
                     "/d { 3 mul 20 min 0 360 arc fill } def\n\n",
                     "%%EndProlog\n%%Page: 1 1\n",
                     ps.centre.x, " ", ps.centre.y, " translate\n", sep='')

  ps.trailer <- "showpage\n%%Trailer"

  this.rates <- rates[iteration,]
  ncells <- length(this.rates)

  fname <- paste("frame", formatC(iteration, width=4,flag="0"), sep='')
  zz <- file(paste(fname,".ps",sep=''), "w")  # open an output file connection
  cat(ps.header, file = zz)
  for (i in 1:ncells) {
   p <- paste(pos[i,1], pos[i,2], this.rates[i], "d\n")
   cat(p, file = zz)
  }

  cat(ps.trailer, file = zz)
  close(zz)

  system(paste("mypstopnm -pbm ", paste(fname,".ps",sep='')))
  system(paste("ppmtogif ", paste(fname,".pbm",sep=''),">",
               paste(fname,".gif",sep='')))
         
  
  fname
}


plot.mealayout <- function(x, use.rownames=FALSE, ...) {
  ## Plot the MEA layout.

  pos <- x$pos
  plot(NA, asp=1,
       xlim=x$xlim, ylim=x$ylim,
       bty="n",
       xlab="", ylab="", type="n")
  if (use.rownames)
    text(pos[,1], pos[,2], rownames(pos), ...)
  else
    text(pos[,1], pos[,2], ...)
}




######################################################################
## Visualisation efforts.


beg.time.t <- tclVar(1)                   #set initial value as 1.
durn.t <- tclVar(100)
cells.t <- tclVar("")
burst.t <- tclVar(1)
label.t <- tclVar(1)

spikeview <- function(s, duration=100) {
  ## Create a Spikeview window and show it.

  ## Init the vars?
  tclvalue(durn.t) <- as.character(duration)
  
  show.plot <- function(...) {
    ## Update the plot window.
    ## TODO: check that beg/end times are suitable.
    beg.time <- as.numeric(tclvalue(beg.time.t))
    durn <- as.numeric(tclvalue(durn.t))

    ## If "cells.t" is currently empty, the string will empty and thus
    ## the cells.t will be set to NULL; otherwise, the expression will
    ## be the sequence of numbers.
    which.cells <- eval(parse(text= tclvalue(cells.t)))
    
    ##x <- floor(beg.time) + (1:durn)
    ##plot(x, data[x], main=beg.time, type='l', yaxt='n')
    plot.mm.s(s, whichcells=which.cells,
              label.cells=(tclvalue(label.t)=="1"),
              show.bursts=(tclvalue(burst.t)=="1"),
              beg=beg.time, end=beg.time+durn)
  }



  update.time <- function(panel) {
    ## Convert duration to a number -- all text items are strings.
    durn <- as.numeric(panel$duration)
    x <- floor(panel$beg.time) + (1:durn)
    plot(x, data[x], main=panel$beg.time, type='l', ylab='n')
    
    ## must return the panel object.
    panel
  }
  
  next.callback <- function() {
    ## Callback for the next button.
    ## TODO: check that it can be updated.
    tclvalue(beg.time.t) <-
      as.character( as.numeric(tclvalue(beg.time.t)) +
                   as.numeric(tclvalue(durn.t)))
    show.plot()
  }

  prev.callback <- function() {
    ## Callback for the prev button.
    tclvalue(beg.time.t) <-
      as.character(as.numeric(tclvalue(beg.time.t)) -
                   as.numeric(tclvalue(durn.t)))
    show.plot()
  }

  returnkey.callback <- function(...) {
    ##  Callback when RETURN is pressed within entry boxes.
    ## Taken from rpanel method.
    show.plot()
  }


  ## Create base frame.
  base <- tktoplevel()
  spec.frame <- tkframe(base, borderwidth=2)
  tkwm.title(base, "Spike viewer")
  
  s.beg.time <- s$rec.time[1]
  s.end.time <- s$rec.time[2]
  scale <- tkscale(spec.frame, command=show.plot,
                   from = s.beg.time,
                   to =   s.end.time, 
                   showvalue=TRUE,
                   variable=beg.time.t,
                   resolution=3,
                   orient="horiz")
  ## The callback for the slider will send, as first argument,
  ## the current value of the slider.

  
  next.but <- tkbutton(spec.frame, text="Next", command=next.callback)
  prev.but <- tkbutton(spec.frame, text="Prev", command=prev.callback)
  

  durn.lab <- tklabel(spec.frame, text="Durn (s)")
  durn.but <- tkentry(spec.frame, textvariable=durn.t,width=5)
  tkbind(durn.but, "<Key-Return>", returnkey.callback)

  cells.lab <- tklabel(spec.frame, text="Cells")
  cells.but <- tkentry(spec.frame, textvariable=cells.t,width=5)
  tkbind(cells.but, "<Key-Return>", returnkey.callback)


  burst.rad <- tkcheckbutton(spec.frame,
                             command=show.plot,
                             text="Burst", indicatoron=1, variable=burst.t)

  labels.rad <- tkcheckbutton(spec.frame,
                             command=show.plot,
                             text="Cell id", indicatoron=1, variable=label.t)
  
  ## Add buttons, one row at a time, using the grid manager.
  tkgrid(scale, columnspan=2)
  tkgrid(prev.but, next.but)
  tkgrid(durn.lab, durn.but)
  tkgrid(cells.lab, cells.but)
  tkgrid(burst.rad, labels.rad)
  
  tkpack(spec.frame)

}




######################################################################
## * Movie functions.


pause.time <- 100                       #delay in msec

movie.time <- tclVar(1)                 # current start time of frame.
movie.show <- tclVar(1)                 # "1" for on, "0" for off.

movie.window <- function(s, beg=NULL, end=NULL) {
  ## Play the movie of the spike trains on the MEA.
  ## BEG and END (if given) are the time in seconds on the array.

  if (is.null(beg))
    beg <- s$rec.time[1]
      
  if (is.null(end))
    end <- s$rec.time[2]

  tclvalue(movie.time) <- as.character(beg)
  
  show.movie.frame <- function(..., update.win=TRUE) {
    start.time <- as.numeric(tclvalue(movie.time))
    ##print(paste("show movie", start.time))
    frame.num <- time.to.frame(s$rates$times, start.time)
    plot.rate.mslayout(s, frame.num, ...)
    if ( update.win && (tclvalue(movie.show)=="1")) {
      next.time <- start.time + s$rates$time.interval
      if (next.time < end ) {
        ## Still have more to show...
        tclvalue(movie.time) <- as.character(next.time)
        tcl("after", pause.time, show.movie.frame)
      } else {
        tclvalue(movie.show) == "0"     #for consistency.
      }
    }
  }

    
    
  stop.callback <- function() {
    ## Callback for the stop button.
    tclvalue(movie.show) <- "0"
  }

  go.callback <- function() {
    ## Callback for the go button.
    tclvalue(movie.show) <- "1"
    show.movie.frame()
  }


  show.plot.scale <- function(...) {
    ## Callback for the scale widget.
    show.movie.frame(update.win=FALSE)
  }

  close.window <- function() {
    ## Callback for when the WM tries to delete the window.
    ## This is needed to stop the movie before destroying the window.
    tclvalue(movie.show) <- "0"
    tkdestroy(base)
  }

  ## Create a control window and show it.
  
  ## Create base frame.
  base <- tktoplevel()
  tcl("wm", "protocol", base, "WM_DELETE_WINDOW", close.window)


  
  spec.frame <- tkframe(base, borderwidth=2)
  tkwm.title(base, "Movie player")
  
  scale <- tkscale(spec.frame,
                   command=show.plot.scale,
                   from = beg, to = end, 
                   showvalue=TRUE, 
                   variable=movie.time,
                   resolution=s$rates$time.interval,
                   orient="horiz")
  
  go.but   <- tkbutton(spec.frame, text="Go",   command=go.callback)
  prev.but <- tkbutton(spec.frame, text="Stop", command=stop.callback)
  

  ## Add buttons, one row at a time, using the grid manager.
  tkgrid(scale, columnspan=2)
  tkgrid(go.but, prev.but)
  
  tkpack(spec.frame)

}


print.mm.s <- function(x) {
  ## Default print method for a SPIKES data structure.
  ## TODO: work on this to make it more sensible.
  cat("MEA spikes\n")
  cat(basename(x$file), "\n")
  cat("nchannels ", x$NCells, "\n")
}
## ncl_mea.R --- Specifics of analysising MEA data from Newcastle.
## Author: Stephen J Eglen
## Copyright: GPL

mcd.data.to.array <- function(file, beg=NULL, end=NULL) {

  ## Read in the MCD data file.  Return the spike trains and the channel
  ## names that are used.
  ## Spikes outside of the time window [BEG, END] (if non-null) are ignored.
  ## BEG and END are given in seconds.
  ## Recall that blank lines will not be read into the data matrix.
  
  data <- read.table(file, as.is=TRUE, skip=2, fill=TRUE)
  

  ## Row number of the start of each spike train.
  channel.start <- which(data[,2] =='Spikes')
  n.channels <- length(channel.start)
  
  ## For the last channel, we add where the end of the file is.
  ## This is so that our check for no spikes will also work for the last
  ## channel in the data set.
  channel.start <- c(channel.start, nrow(data))

  ## Name of each channel.
  channels <- data[channel.start,4]
  channel.ok <- rep(0, n.channels)
  spikes <- list(); n <- 0
  
  for (channel  in 1:n.channels) {
    beg.spike <- channel.start[channel]+2 #first spike for this channel
    if (beg.spike < channel.start[channel+1]) {
      ## We have some data.
      end.spike <- channel.start[channel+1] - 1 #last line

      ## convert data from msec to seconds.
      this.train <- as.numeric(data[beg.spike:end.spike,1]) / 1000

      if (!is.null(beg)) {
        rejs <- which(this.train < beg)
        if (any(rejs))
          this.train <- this.train[-rejs]
      }

      if ( any(this.train) && !is.null(end)) {
        rejs <- which(this.train > end)
        if (any(rejs))
          this.train <- this.train[-rejs]
      }

      if (any(this.train)) {
        n <- n + 1
        spikes[[n]] <- this.train
        channel.ok[n] <- channels[channel]
      }

    }

  }

  channel.ok <- channel.ok[1:n]         #truncate to right length.
  res <- list(spikes=spikes, channels=channel.ok) 
}





ncl.read.spikes <- function(filename, ids=NULL,
                            time.interval=1, beg=NULL, end=NULL) {

  ## Read in Ncl data set.  IDS is an optional vector of cell numbers
  ## that should be analysed -- the other channels are read in but
  ## then ignored.


  ## Tue 25 Jul 2006 -- I'm not sure if this is the cleanest way to read in the
  ## data files, as it probably can be read in using just
  ## read.csv(filename, sep='\t')
  ## but since this works, fine.
  

  dat <- mcd.data.to.array(filename, beg, end)
  spikes <- dat$spikes
  channels <- dat$channels

  spikes.range <- range(unlist(spikes))
  if (is.null(beg))  beg <-  spikes.range[1]
  if (is.null(end))  end <-  spikes.range[2]
  rec.time <- c(beg, end)

  
  ## Count the number of spikes per channel, and label them.
  nspikes <- sapply(spikes, length)

  ## TODO
  ## names(nspikes) <- channels 

  ## meanfiring rate is the number of spikes divided by the (time of
  ## last spike - time of first spike).  
  ##meanfiringrate <- nspikes/ ( sapply(spikes, max) - sapply(spikes, min))
  ## todo -- find min, max time.

  meanfiringrate <- nspikes/ ( end - beg)

  ## Parse the channel names to get the cell positions.
  layout <- make.sanger1.layout(substring(channels, 1,2))
  
  ## check that the spikes are monotonic.
  check.spikes.monotonic(spikes)


  rates <- make.spikes.to.frate(spikes, time.interval=time.interval,
                                beg=beg, end=end)
  
  ## See if we need to shift any units.  this affects only the
  ## visualisation of the units in the movies.  We assume that "shifted"
  ## positions are stored in the file with same name as data file
  ## except that the .txt is replaced with .sps.  Then each line of this
  ## file contains three numbers:
  ## c dx dy
  ## where c is the cell number to move, and dx,dy is the amount (in um)
  ## by which to move the cells.  If you edit the file, this function
  ## must be called again for the new values to be read in.
  ## The shifted positions are used only by the movie functions and
  ## by the function plot.shifted.jay.pos(s) [this shows all units].


  ## Tue 19 Dec 2006: this assumes filename ends in .txt; do not worry
  ## about this for now.
  
##   shift.filename <- sub("\\.txt$", ".sps", filename)
   unit.offsets <- NULL                  #default value.
##   if (FALSE && file.exists(shift.filename)) { #TODO -- why running?
##     updates <- scan(shift.filename)
##     ## must be 3 data points per line
##     stopifnot(length(updates)%%3 == 0)
##     updates <- matrix(updates, ncol=3, byrow=TRUE)
##     units <- updates[,1]
##     if (any(units> length(spikes))) {
##       stop(paste("some units not in recording...",
##                  paste(units[units>=length(spikes)],collapse=",")))
##     }
##     unit.offsets <- layout$pos*0               #initialise all elements to zero.
##     unit.offsets[units,] <- updates[,2:3]
##   }
  
  
  
  res <- list( channels=channels,
              spikes=spikes, nspikes=nspikes, NCells=length(spikes),
              meanfiringrate=meanfiringrate,
              file=filename,
              layout=layout,
              rates=rates,
              unit.offsets=unit.offsets,
              rec.time=rec.time
              )
  class(res) <- "mm.s"

  ncl.breaks = c(0, 150, 250, 350, 450, 550, 650, 1000, 2000)
  res$corr = corr.index(res, ncl.breaks)

  res

}
## networkspikes.R --- identify and analsyse network spikes
## Author: Stephen J Eglen
## Copyright: GPL
## Sun 28 Jan 2007
## Taking ideas from Eytan & Marom J Neurosci (2006).



##ns.T = 0.003                             #bin time for network spikes
##ns.N = 10                               #number of active electrodes.

## 2007-07-27: Code merged in from second version, temp in
## ~/proj/sangermea/test_ns.R 

compute.ns <- function(s, ns.T, ns.N, sur, plot=FALSE) {
  ## Main entrance function to compute network spikes.
  ## Typical values:
  ## ns.T: 3
  ## ns.N: 10
  ## sur: 100

  counts <- spikes.to.count2(s$spikes, time.interval=ns.T)
  p <- find.peaks(counts, ns.N)
  ns <- list(counts=counts, ns.N=ns.N, ns.T=ns.T)
  class(ns) <- "ns"
  m <- mean.ns(ns, p, plot=plot, nrow=4, ncol=4, ask=FALSE, sur=sur)
  if (is.null(m)) {
    ## No network spikes found.
    ns$brief <- c(n=0, peak.m=NA, peak.sd=NA, durn.m=NA, durn.sd=NA)
  } else {
    ns$mean <- m$ns.mean; ns$measures <- m$measures
    peak.val <- ns$measures[,"peak.val"]
    durn <- ns$measures[,"durn"]
    ns$brief <- c(n=nrow(ns$measures),
                  peak.m=mean(peak.val), peak.sd=sd(peak.val),
                  durn.m=mean(durn, na.rm=TRUE), durn.sd=sd(durn, na.rm=TRUE))

  }
  
  ns
}

spikes.to.count2 <- function(spikes,
                            time.interval=1, #time bin of 1sec.
                            beg=floor(min(unlist(spikes))),
                            end=ceiling(max(unlist(spikes)))
                            )
{
  ## Convert the spikes for each cell into a firing rate (in Hz)
  ## We count the number of spikes within time bins of duration
  ## time.interval (measured in seconds).
  ##
  ## Currently cannot specify BEG or END as less than the
  ## range of spike times else you get an error from hist().  The
  ## default anyway is to do all the spikes within a data file.
  ##
  ## C version, which should replace spikes.to.count
  ## Returns a time series object.

  ## Each bin is of the form [t, t+dt) I believe, as shown by:
  ## spikes.to.count2(list( c(0, 6.9), c( 2, 4)))
  
  ## time.breaks <- seq(from=beg, to=end, by=time.interval)
  nbins <- ceiling( (end-beg) / time.interval)

  nspikes <- sapply(spikes, length)     #already computed elsewhere!
  
  z <- .C("ns_count_activity",
          as.double(unlist(spikes)),
          as.integer(nspikes),
          as.integer(length(nspikes)),
          as.double(beg), as.double(end), as.double(time.interval),
          as.integer(nbins),
          counts = integer(nbins),
          PACKAGE="sjemea")
  
  ## Return counts as a time series.
  res <- ts(data=z$counts, start=beg, deltat=time.interval)

  res
}

plot.ns <- function(ns, ...) {
  ## Plot function for "ns" class.
  plot(ns$counts, ...)
  abline(h=ns$ns.N, col='red')

  ##peak.times <- times[ ns$peaks[,1]]
  peak.times <- ns$measures[,"time"]
  peak.val   <- ns$measures[,"peak.val"]
  points(peak.times, peak.val, col='blue', pch=19)

}

summary.ns <- function(ns) {
  ## Summary function for "ns" class.
  n <- ns$brief["n"]
  cat(sprintf("%d network spikes\n", n))
  peak.m <- ns$brief["peak.m"]
  peak.sd <- ns$brief["peak.sd"]


  durn.m <- ns$brief["durn.m"]
  durn.sd <- ns$brief["durn.sd"]
  cat(sprintf("recruitment %.2f +/- %.2f\n", peak.m, peak.sd))
  cat(sprintf("FWHM %.3f +/- %.3f (s)\n", durn.m, durn.sd))
}

mean.ns <- function(ns, p, sur=100,
                    plot=TRUE, nrow=8, ncol=8, ask=FALSE) {
  ## Compute the mean network spikes, and optionally show the
  ## individual network spikes.

  ## This code does not check to worry if there is a spike right at either
  ## end of the recording.  naughty!

  if (is.null(p)) {
    if (is.null(ns$measures)) {
      cat("*** No network spikes found\n")
      return (NULL)
    } else {
      ## use info previously stored in measures.
      p <- ns$measures
    }
  }

  
  if (plot) {
    old.par <- par(mfrow=c(nrow,ncol), mar=c(2.5,1,1,1),ask=ask)
  }
  ave = rep(0, (2*sur)+1)
  npts = length(ns$counts)
  times <- time(ns$counts)
  measures = matrix(NA, nrow=nrow(p), ncol=4)
  colnames(measures) = c("time", "index", "peak.val", "durn")
  n.ns = 0                              #Number of valid network spikes found
  for (i in 1:nrow(p)) {
    peak.i = p[i,"index"]; lo = (peak.i-sur); hi = peak.i+sur

    ## Check that enough data can be found:
    if ( (lo >0) && ( hi < npts) ) {
      n.ns = n.ns + 1

      dat = ns$counts[lo:hi]
      peak.val = dat[sur+1]
      measures[n.ns, "time"] = times[peak.i]
      measures[n.ns, "index"] = peak.i
      measures[n.ns, "peak.val"] = peak.val
      

      if (plot) {
        plot(dat, xaxt='n', yaxt='n', ylim=c(0,60),
             bty='n', type='l',xlab='', ylab='')
        ##abline(v=sur+1)
        max.time <- ns$ns.T * sur
        axis(1, at=c(0,1,2)*sur,
             ##labels=c('-300 ms', '0 ms', '+300 ms'))
             labels=c(-max.time, 0, max.time))

      }
      
      hm = find.halfmax(dat, peak.n=sur+1, frac=0.5, plot=plot)
      measures[n.ns, "durn"] = hm$durn* ns$ns.T
      if (plot) {
        text <- sprintf("%d durn %.3f",
                        round(peak.val), measures[n.ns, "durn"])
        legend("topleft", text, bty='n')
      }

      ##dat2 = dat;
      ##dat2[1:(hm$xl-1)] = 0;
      ##dat2[(hm$xr+1):((2*sur)+1)] = 0;
      
      ##k = kurtosis(dat2)
      ##measures[n.ns, 1] = k
      ave = ave + dat


    }
  }

  if (n.ns < nrow(p)) {
    ## Some peaks could not be averaged, since they were at either
    ## beg/end of the recording.
    ## So, in this case, truncate the matrix of results to correct
    ## number of rows.
    measures = measures[1:n.ns,,drop=FALSE]
  }
  
  ## now show the average
  if (n.ns > 0) {
    ave = ave/n.ns
    if (plot) {
      plot(ave, xaxt='n', yaxt='n', bty='n', type='l',xlab='', ylab='')
      legend("topleft", paste("m", round(max(ave))), bty='n')
      find.halfmax(ave)
    }


    ##stripchart(measures[,1], ylab='K', method='jitter', vert=T, pch=19,
    ##main=paste('kurtosis', round(mean(measures[,1]),3)))
    if (plot) {
      stripchart(measures[,"durn"], ylab='durn (s)', method='jitter',
                 vert=TRUE, pch=19,
                 main=paste('FWHM durn', round(mean(measures[,"durn"]),3)))
    }

    if (plot) {
      par(old.par)
    }

  }

  
  ns.mean = ts(ave, start=(-sur*ns$ns.T), deltat=ns$ns.T)

  list(measures=measures, ns.mean=ns.mean)
}

show.ns <- function(ns, ...) {
  ## Show the individual network spikes after they have been computed.
  ##
  ## This is useful if you don't show the individual network spikes
  ## when they are first iterated over to calculate the mean.
 
  res <- mean.ns(ns, p=NULL, ...)
  NULL                                  #ignore result
}




find.peaks <- function(trace, ns.N) {

  ## Peaks are defined as being all elements between two zero entries
  ## (one at start, one at end) in the time series.  An alternate
  ## definiton might be to require some number N of consecutive zero
  ## entries to surround a peak.
   
  max.peaks = 200000

  npts = length(trace)
  
  peaks = matrix(NA, nrow=max.peaks, ncol=2)
  colnames(peaks) <- c("index", "peak.val")
  n = 0

  inside = FALSE;

  for (i in 1:npts) {

    cur = trace[i]    

    if(inside) {
      ## currently in a peak.
      if (cur == 0) {
        ## no longer inside a peak, save results if peak was tall enough.
        inside=FALSE;

        if (peak > ns.N) {
          n=n+1
          if (n > max.peaks) {
            ## oh oh, need more room.
            browser()
          } else {
            peaks[n,] = c(peak.t, peak)
          }
        }
        
      } else {
        ## still in a peak
        if (cur > peak) {
          peak = cur; peak.t = i;
        }
      }
    } else {
      ## currently outside a peak.
      if (cur > 0) {
        inside = TRUE; peak = cur; peak.t = i
      }
    }
  }

  ## tidy up result at end.

  if (n > 0) {
    peaks = peaks[1:n,,drop=FALSE]
  } else {
    ## no peaks found.
    peaks = NULL
  }
}




find.halfmax.cute <- function(y) {
  ## Given a peak within DAT, find the FWHM.
  ## This is a cute method, but not robust enough -- since it assumes
  ## that the peak is unimodel -- which may not be the case.
  

  x = 1:length(y)
  p.t = 101                             #HACK!!!
  half.max = y[p.t]/2                   #HACK!!!
  f <- approxfun(x, y)
  f2 <- function(x) { f(x) - half.max }
  l <- uniroot(f2, lower=1, upper=p.t)
  r <- uniroot(f2, lower=p.t, upper=length(y))

  segments(l$root, f(l$root), r$root, f(r$root), col='blue')

}



find.halfmax <- function(y, peak.n=NULL, plot=TRUE, frac=0.5) {

  ## Given a peak somwhere with Y, find the FWHM.
  ##
  ## If PEAK.N is not null, it will be location of the peak -- this is helpful
  ## when there are multiple peaks within one window, and we want to find
  ## the FWHM of the non-major peak.
  ## By default, frac = 0.5, to find the half max.  Change this to some other
  ## value, e.g. 10% to find 10% onset and offset.
  ## 
  ##
  ## This may fail for a few reasons, e.g. not finding half-max values within
  ## the range, running out of data...
  ## all of which should be counted for!

  n = length(y)

  if (is.null(peak.n))
    peak.n = which.max(y)
  
  peak.val = y[peak.n]

  half.max = peak.val * frac
  
  ## Break the data into three segments:

  ## llllllllllllllllllPrrrrrrrrrrrrrrrrr
  ## P is the peak; examine curve to the left (lll) and to the right (rrr) to
  ## find when the peak has decayed to half max.

  left.y = y[1:(peak.n-1)]
  right.y = y[(peak.n+1):n]

  ## When finding the halfmax value in the left and right side, we
  ## have to check that first all of the halfmax value can be found.
  ## e.g. if the peak value is 50 and all values to the left are 45,
  ## there is no value to the left which is under 25, and so the half
  ## max value cannot be computed.
  

  ## Assume the half max point can be found, we interpolate to find
  ## the point, see below.
  
  underhalf.l = which(left.y < half.max)
  if ( any(underhalf.l) ) {
    xl1 = underhalf.l[length(underhalf.l)]   #get last point under halfmax.
    xl2 = xl1+1
    
    yl1 = y[xl1]; yl2 = y[xl2]
    dy = half.max - yl1


    ## see picture.
    ## below, (xl2 - xl1) should equal 1.
    dx = (dy  *(xl2-xl1))/ (yl2-yl1)
    
    xl.half = xl1 + dx
  } else {
    xl.half = NA                        # could not find half-max to left.
  }

  ## Now work on right of curve.  find first point at which y falls below
  ## half max value.
  underhalf.r = which(right.y < half.max)
  if ( any(underhalf.r) ) {
    xr2 = underhalf.r[1] + peak.n
    xr1 = xr2 - 1
    
    yr1 = y[xr1]; yr2 = y[xr2]
    dy = half.max - yr2
    
    dx = dy * (xr1-xr2)/(yr1-yr2)

    ##stopifnot(dx<0)
    xr.half = xr2 + dx
  } else {
    xr.half = NA
  }

  
  if(plot) {
    ##abline(v=xl.half, col='green'); abline(v=xr.half, col='green'); #temp
    abline(h=peak.val * frac, col='red')
    if (! any(is.na(c(xl.half, xr.half)))) {
      ## check first that both half-maxes are valid.
      segments(xl.half, half.max, xr.half, half.max, col='blue')
    }
  }

  list(xl=xl.half, xr=xr.half, durn=xr.half-xl.half)
}

## now interpolate -- hard way
## a <- approx(x, y, n=length(y)*30)
## lines(a)

## amax.x = which.max(a$y)
## points(a$x[amax.x], a$y[amax.x], col='blue', pch=19)

## ## find right side down.
## half.max = max(y)/2
## rx <- which(a$y[-(1:amax.x)]< half.max)[1] + amax.x

## ## find left side down.
## lx <- which(a$y[1:amax.x]< half.max)
## lx <- lx[length(lx)]
## segments(a$x[lx], a$y[lx],  a$x[rx], a$y[rx], col='blue')

## The "R" way of interpolating -- nice!


check.ns.plot <- function(counts, p, xlim, ns.N) {

  plot(counts$times, counts$sum, type='l', xlim=xlim,
       xlab="time (s)", ylab='num active channels')
  points(counts$times[p[,1]], p[,2], pch=19, col='blue')
  abline(h=ns.N, col='red')               #threshold line.
}

ns.bin.peak <- function(p, nbins=12, wid=5) {
  ## Bin values in P into a set of NBINS bins, of size WID.
  ## Bins are right-closed (except for first bin, closed at both ends).
  ## Labels are added onto the bins.
  ##
  ## x <- c(0, 4,5, 20, 54,55, 60)
  ## ns.bin.peak(x, wid=10, nbins=7 )
  ##

  if ( is.null(p) ) {
    ## no valid values, so no need to make the histogram.
    ## This happens when there are no network spikes.
    p <- 0; invalid <- TRUE
  } else {
    invalid <- FALSE
  }
  
  b <- seq(from=0, by=wid, length=nbins+1)
  max.allowed <- max(b)
  if ( any( above <- which(p > max.allowed)) ) {
    stop("some values above max.allowed")
  }
  h <- hist(p, plot=FALSE, breaks=b)
  c <- h$counts

  if (invalid) {
    ## no valid counts, so set all counts to zero.
    c <- c*0
  }
  
  l <- hist.make.labels(0, max.allowed, nbins)
  names(c) <- l
  c
}



ns.identity <- function(s, w=0.1) {
  ## Return the "NSID" matrix, Network Spike IDentity.
  ## Which channels contributed to which network spikes?
  ## W is window of spike identity, +/- 0.1s by default.

  ## peak.times here should be the middle of the NS bin.
  peak.times <- s$ns$measures[,"time"] + (s$ns$ns.T/2)

  ## We do the transpose here so that one row is one network spike.
  nsid <- t(ns.coincident(peak.times, s$spikes, w))

  
}

ns.coincident <- function(a, bs, w) {
  ## A is a vector of reference times, sorted, lowest first.  (Here
  ## the times of the peaks of the network spikes.)
  ## B is a list of vectors of spike times.  (Each vector of spike
  ## times is sorted, lowest first.)

  ## For each spike train in B, we see if there was a spike within a
  ## time window +/- W of the time of each event in A.  If there was a
  ## "close" spike in spike train j from B to event i , then
  ## MAT[j,i]=1.
  ## (MAT is a matrix of size CxN, where C is the number of spike
  ## trains in BS, and N is the number of events in A.)
  ## MAT is transposed by the higher level function -- it is kept this
  ## way for ease of the C implementation.
  spike.lens <- sapply(bs, length)
  num.channels <- length(spike.lens)
  z <- .C("coincident_arr", as.double(a), as.integer(length(a)),
          as.double(unlist(bs)), as.integer(spike.lens),
          as.integer(num.channels),
          close = integer(length(a)*num.channels),
          as.double(w), PACKAGE="sjemea")
  
  mat <- matrix(z$close, nrow=num.channels, byrow=TRUE)
  dimnames(mat) <- list(channel=1:num.channels, ns.peak=a)
  mat

}

######################################################################
## End of functions
######################################################################

##  https://stat.ethz.ch/pipermail/r-help/2005-November/083376.html
## Martin Machler, Nov 2005.

peaks <- function(series, span = 3, do.pad = TRUE) {
    if((span <- as.integer(span)) %% 2 != 1) stop("'span' must be odd")
    s1 <- 1:1 + (s <- span %/% 2)
    if(span == 1) return(rep.int(TRUE, length(series)))
    z <- embed(series, span)
    v <- apply(z[,s1] > z[, -s1, drop=FALSE], 1, all)
    if(do.pad) {
        pad <- rep.int(FALSE, s)
        c(pad, v, pad)
    } else v
}

peaksign <- function(series, span = 3, do.pad = TRUE)
{
    ## Purpose: return (-1 / 0 / 1) if series[i] is ( trough / "normal" / peak )
    ## ----------------------------------------------------------------------
    ## Author: Martin Maechler, Date: 25 Nov 2005

    if((span <- as.integer(span)) %% 2 != 1 || span == 1)
        stop("'span' must be odd and >= 3")
    s1 <- 1:1 + (s <- span %/% 2)
    z <- embed(series, span)
    d <- z[,s1] - z[, -s1, drop=FALSE]
    ans <- rep.int(0:0, nrow(d))
    ans[apply(d > 0, 1, all)] <- as.integer(1)
    ans[apply(d < 0, 1, all)] <- as.integer(-1)
    if(do.pad) {
        pad <- rep.int(0:0, s)
        c(pad, ans, pad)
    } else ans
}


check.pks <- function(y, span = 3) {
  stopifnot(identical(peaks( y, span), peaksign(y, span) ==  1),
            identical(peaks(-y, span), peaksign(y, span) == -1))
}

for(y in list(1:10, rep(1,10), c(11,2,2,3,4,4,6,6,6))) {
    for(sp in c(3,5,7))
        check.pks(y, span = sp)
    stopifnot(peaksign(y) == 0)
}

y <- c(1,4,1,1,6,1,5,1,1) ; (ii <- which(peaks(y))); y[ii]
##- [1] 2 5 7
##- [1] 4 6 5
check.pks(y)

set.seed(7)
y <- rpois(100, lambda = 7)
check.pks(y)
py <- peaks(y)
plot(y, type="o", cex = 1/4, main = "y and peaks(y,3)")
points(seq(y)[py], y[py], col = 2, cex = 1.5)

p7 <- peaks(y,7)
points(seq(y)[p7], y[p7], col = 3, cex = 2)
mtext("peaks(y,7)", col=3)

set.seed(2)
x <- round(rnorm(500), 2)
y <- cumsum(x)
check.pks(y)

plot(y, type="o", cex = 1/4)
p15 <- peaks(y,15)
points(seq(y)[p15], y[p15], col = 3, cex = 2)
mtext("peaks(y,15)", col=3)
## ranksurprise.R --- Rank Surprise method for burst detection.
## Author: Zhengzheng Zhang
## Copyright: GPL.
## Following method in Gourevitch and Eggermont (2007)

## "Rank Surprise" method for burst detection. The method and algorithm are 
## described in the paper, a nonparametric approach for detection of bursts 
## in spike trains. See reference.


val2rk <- function(values) {
  ## Convert values to ranks, with mean of ranks for tied values. Alternative
  ## and faster version of "tiedrank" in statistical toolbox of Matlab 6-7.
  
  lp = length(values)
  rk = rk2 = rep(0,lp)
  S = sort(values, index.return = TRUE)
  y = S$x
  cl = S$ix
  rk[cl] = c(1:lp)
  cl2 = sort(-values, index.return = TRUE)$ix
  rk2[cl2] = c(1:lp)
  ranks = (lp+1-rk2+rk)/2
  ranks
}


rs.find.burst <- function(s, limit = NULL, RSalpha = -log(0.01)) {
  nspikes = length(s)
  if (nspikes <= 10) {
    archive_burst = NA
  }else{
    ## General parameters
    
    ## limit for using the real distribution
    q_lim = 30
    ## minimum length of a burst in spikes
    l_min = 3
    
    ## General vectors

    ## vector (-1)^k
    alternate = rep(1, 400)
    alternate[c(1:200)*2] = -1
    ## log factorials
    log_fac = cumsum(log(1:q_lim))
    
    ## Ranks computation
    
    ## compute the ISI
    ISI = diff(s)
    N = length(ISI)
    ## ISI value not to include in a burst
    if (length(limit)==0){
      ## percentile 75% (default)
      limit=summary(ISI)["3rd Qu."][[1]]
    }

    ## compute ranks
    R = val2rk(ISI)
    
    ## Find sequences of ISI under 'limit'
    
    D = rep(0, N)
    D[ISI<limit]=1
    ISI_limit = diff(D)
    ## first time stamp of these intervals
    begin_int = which(ISI_limit==1)+1
    ## manage the first ISI
    if (ISI[1]<limit){
      begin_int = c(1, begin_int)      # the first IS is under limit
    }    
    ## last time stamp of these intervals
    end_int = which(ISI_limit==-1)
    ## manage the last ISI
    if (length(end_int)<length(begin_int)){
      end_int=c(end_int, N)
    }
    ## length of intervals of interest
    length_int=end_int-begin_int+1
    
    ## Initializations
    archive_burst_RS=c()
    archive_burst_length=c()
    archive_burst_start=c()
    archive_burst_end=c()
    archive_burst_IBI=c()
    archive_burst_durn=c()
    archive_burst_mean.isis=c()

    ## Going through the intervals of interest
    indic=0
    for (n_j in begin_int){
      indic=indic+1
      p_j=length_int[indic]
      subseq_RS = NULL 
      subseq_RS_RS=c()
      subseq_RS_i =c()
      subseq_RS_q =c()     
      ## test each set of spikes
      for (i in 0:(p_j-(l_min-1))){
        ## length of burst tested
        q=l_min-2
        while (q<(p_j-i)){
          q=q+1
          ## statistic
          u=sum(R[(n_j+i):(n_j+i+q-1)])
          u=floor(u)
          if (q<q_lim){
            ## exact discrete distribution
            k=c(0:((u-q)/N))
            length_k=length(k) 
            SUM = 0                     
            for (j in 1:q){
              SUM = SUM + log(u-matrix(rep(k,q),q,length_k, byrow = TRUE)*N
                - matrix(rep(c(0:(q-1)),length_k),length(c(0:(q-1))),length_k))[j,]
            }      
            if (length_k<2){
              prob = exp((SUM- log_fac[1]-log_fac[q-k])-q*log(N))%*%alternate[1:length_k]
            }else{
              prob = exp((SUM- log_fac[c(1, k[2:length_k])]-log_fac[q-k])-q*log(N))%*%alternate[1:length_k]
            }    
          }else{
            ## approximate Gaussian distribution
            prob=pnorm((u-q*(N+1)/2)/sqrt(q*(N^2-1)/12))
          }
          RS=-log(prob)
          ## archive results for each subsequence [RSstatistic beginning length]
          if (RS>RSalpha){
            subseq_RS_RS[length(subseq_RS_RS)+1]=RS
            subseq_RS_i[length(subseq_RS_i)+1]=i
            subseq_RS_q[length(subseq_RS_q)+1]=q
            subseq_RS = rbind(subseq_RS_RS, subseq_RS_i, subseq_RS_q)
            subseq_RS = t(as.matrix(subseq_RS))
          }
        }
      }
      ## vet results archive to extract most significant bursts
      if (length(subseq_RS)!=0){
        ## sort RS for all subsequences
        if (!is.vector(subseq_RS)){
          ind = sort(subseq_RS[,1], decreasing = TRUE, index = TRUE)$ix
          subseq_RS = subseq_RS[ind,]
        }           
        while (length(subseq_RS)!=0){
          ## extract most surprising burst
          if (is.vector(subseq_RS)){
            current_burst=subseq_RS
            archive_burst_RS[length(archive_burst_RS)+1]=current_burst[1]
            archive_burst_length[length(archive_burst_length)+1]=current_burst[3]+1  #number of ISI involved + 1
            archive_burst_start[length(archive_burst_start)+1]=n_j+current_burst[2]
            archive_burst_end[length(archive_burst_end)+1]=n_j+current_burst[2]+current_burst[3]
            subseq_RS=NULL
          }else{                      
            current_burst=subseq_RS[1,]
            archive_burst_RS[length(archive_burst_RS)+1]=current_burst[1]
            archive_burst_length[length(archive_burst_length)+1]=current_burst[3]+1 #number of ISI involved + 1
            archive_burst_start[length(archive_burst_start)+1]=n_j+current_burst[2]
            archive_burst_end[length(archive_burst_end)+1]=n_j+current_burst[2]+current_burst[3]
            ## remove most surprising burst from the set
            ## subseq_RS=subseq_RS(2:end,:);
            ## keep only other bursts non-overlapping with this burst
            D = (subseq_RS[,2]+subseq_RS[,3]-1)<current_burst[2]
            E = subseq_RS[,2]>(current_burst[2]+current_burst[3]-1)
            subseq_RS=subseq_RS[D|E,]
          }
        }
      }
    }
    
    ## sort bursts by ascending time
    if (length(archive_burst_RS)!=0){
      S = sort(archive_burst_start, index.return = TRUE)
      archive_burst_start = S$x
      ind_sort = S$ix
      archive_burst_RS=archive_burst_RS[ind_sort]
      archive_burst_length=archive_burst_length[ind_sort]
      archive_burst_end=archive_burst_end[ind_sort]
      last.end = archive_burst_end[-length(archive_burst_end)]
      last.end = c(NA, s[last.end])
      archive_burst_IBI = s[archive_burst_start]-last.end
      archive_burst_durn = s[archive_burst_end]-s[archive_burst_start]
      archive_burst_mean.isis = archive_burst_durn/(archive_burst_length-1)
      archive_burst=cbind(beg=archive_burst_start, end=archive_burst_end, IBI=archive_burst_IBI,
        len=archive_burst_length, durn=archive_burst_durn, 
        mean.isis=archive_burst_mean.isis, SI=archive_burst_RS)
    }else{
      archive_burst = NA
    }
  }
  archive_burst
} 
## sanger.R --- Specifics of analysising MEA data from Sanger centre.
## Author: Stephen J Eglen
## Copyright: GPL
## Fri 19 Jan 2007


######################################################################
## Code for Sanger MEA analysis,
######################################################################

sanger.init <- function() {
  ## Run for initialisation of analysis of Sanger data.

  windows <- .Platform$OS.type !='unix'

  if (windows) {
    ## Set up on Windows machine.
    ## Scripts are stored in meadev/scripts.
    setwd("c:/meadev/scripts")
    assign("mea.data.dir", "c:/meadev/data/", env = .GlobalEnv)
    assign("mea.table.dir", "c:/meadev/tables/", env = .GlobalEnv)
    assign("mea.op.dir", "c:/meadev/op/", env = .GlobalEnv)
  } else {
    if (file.exists("/nfs/g2c_electrophys/meadev/") ) {

      ## Set up for Sanger deskpro15402 machine.
      assign("mea.data.dir",   "/nfs/g2c_electrophys/meadev/data/",
             env = .GlobalEnv)
      assign("mea.table.dir",  "/nfs/g2c_electrophys/meadev/tables/",
             env = .GlobalEnv)
      assign("mea.op.dir",     "/nfs/g2c_electrophys/meadev/op/",
             env = .GlobalEnv)
    } else {
      ## Set up for linux.
      assign("mea.data.dir",   "~/proj/sangermea/data/", env = .GlobalEnv)
      assign("mea.table.dir",  "~/proj/sangermea/tables/", env = .GlobalEnv)
      assign("mea.op.dir",     "~/proj/sangermea/op/", env = .GlobalEnv)
    }
  }

  ## Create the cache of datafiles.
  assign("mea.data.files",  make.meafile.cache(mea.data.dir),
         env  = .GlobalEnv)
}

mea.op <- function(f) {
  ## Create a new output file.
  sprintf("%s%s", mea.op.dir, f)
}

make.sanger1.layout <- function(positions) {
  ## make the layout for SANGER MEA


  xlim <- ylim <- c(50, 1700)
  spacing <- 200

  cols <- as.integer(substring(positions, 1,1)) * spacing
  rows <- (9-as.integer(substring(positions, 2,2))) * spacing
  pos <- cbind(cols, rows)
  
  rownames(pos) <- positions
  
  layout <- list(xlim=xlim, ylim=ylim, spacing=spacing,
                 pos=pos)

  class(layout) <- "mealayout"

  layout

}


sanger.read.spikes <- function(filename, ids=NULL,
                               time.interval=1,
                               beg=NULL, end=NULL,
                               min.rate=0) {

  ## Read in Sanger data set.  
  ## IDS (IGNORE FOR NOW)is
  ## an optional vector of cell numbers that should be analysed -- the
  ## other channels are read in but then ignored.

  ## MIN.RATE (when >0) is the mininum firing rate (Hz) that a channel
  ## must have for it to be analysed.  e.g. a sensible threshold would
  ## be 1/60 to indicate it must on average make one spike/minute to
  ## be analysed.
  


  ## gzfile can also open uncompresed files, so this should work for
  ## both compressed and uncompressed text files.
  f2 <- file.or.gz(filename)

  if (any(grep('.gz$', f2))) {
    con <- gzfile(f2)
  } else {
    con <- file(filename)
  }

  ## read in all the data.
  raw <- read.table( con, sep='\t', as.is=TRUE, header=TRUE)

  if ( colnames(raw)[1] == "StartStop") {
    dat <- raw[,-(1:3)]
    dat.start <- raw[1,2]
    dat.stop  <- raw[1,3]
  } else {
    raw.ncol <- ncol(raw)
    if ( colnames(raw)[raw.ncol] ==  "Sweep_Stop") {
      dat <- raw[,1:(raw.ncol-2)]
      dat.start <- raw[1, raw.ncol-1]
      dat.stop  <- raw[1, raw.ncol]
    } else {
      stop("Cannot read this file\n")
    }
  }

  sweep.start <- dat.start; sweep.stop <- dat.stop
  channels <- colnames(dat)

  ## remove the NA from the end of each list.
  spikes <- sapply(dat, simplify=FALSE, jay.filter.for.na)


  if (!is.null(end)) {
    spikes <- lapply(spikes, jay.filter.for.max, max=end)
  } else {
    end <- sweep.stop
  }

  if (!is.null(beg)) {
    spikes <- lapply(spikes, jay.filter.for.min, min=beg)
  } else {
    beg <- sweep.start
  }

  if (min.rate > 0 ) {
    
    ## Check for inactive channels -- those with a mean firing rate
    ## below some average rate.

    ## This catches the odd situation when a channel has no spikes on
    ## it -- this can happen when a duration (beg, end) is given where
    ## no spikes occur on that channel.
    
    
    nspikes <- sapply(spikes,length)
    durn <- sweep.stop - sweep.start
    rates <- nspikes/durn
    inactive <- which(rates < min.rate)
    if (any(inactive)) {
      cat(paste("Removing spikes with low firing rates: ",
                paste(inactive, collapse=' '), "\n"
                ))
      spikes = spikes[-inactive]
      channels = channels[-inactive]
    }
    
    
  }


  
  if (!is.null(ids) ) {
    if (any(ids>length(spikes)))
      stop(paste("some ids not in this data set:",
                 paste(ids[ids>length(spikes)],collapse=" ")))
    
    spikes <- spikes[ids];
    channels <- channels[ids];
  }

  ## Count the number of spikes per channel, and label them.
  nspikes <- sapply(spikes, length)
  names(nspikes) <- channels

  ## meanfiring rate is the number of spikes divided by the (time of
  ## last spike - time of first spike).  
  meanfiringrate <- nspikes/ ( end - beg)

  ## Parse the channel names to get the cell positions.
  layout <- make.sanger1.layout(substring(channels, 4, 5))

  ## check that the spikes are monotonic.
  check.spikes.monotonic(spikes)


  rates <- make.spikes.to.frate(spikes, time.interval=time.interval,
                                beg=beg, end=end)
  
  ## See if we need to shift any units.  this affects only the
  ## visualisation of the units in the movies.  We assume that "shifted"
  ## positions are stored in the file with same name as data file
  ## except that the .txt is replaced with .sps.  Then each line of this
  ## file contains three numbers:
  ## c dx dy
  ## where c is the cell number to move, and dx,dy is the amount (in um)
  ## by which to move the cells.  If you edit the file, this function
  ## must be called again for the new values to be read in.
  ## The shifted positions are used only by the movie functions and
  ## by the function plot.shifted.jay.pos(s) [this shows all units].


  ## Tue 19 Dec 2006: this assumes filename ends in .txt; do not worry
  ## about this for now.
  
  shift.filename <- sub("\\.txt$", ".sps", filename)
  unit.offsets <- NULL                  #default value.
  if (FALSE && file.exists(shift.filename)) { #TODO -- why running?
    updates <- scan(shift.filename)
    ## must be 3 data points per line
    stopifnot(length(updates)%%3 == 0)
    updates <- matrix(updates, ncol=3, byrow=TRUE)
    units <- updates[,1]
    if (any(units> length(spikes))) {
      stop(paste("some units not in recording...",
                 paste(units[units>=length(spikes)],collapse=",")))
    }
    unit.offsets <- pos*0               #initialise all elements to zero.
    unit.offsets[units,] <- updates[,2:3]
  }

  ## Compute CV of ISI.
  mean.isi = sapply(spikes, function(s) { mean(isi(s))})
  
  cv.isi = sapply(spikes, cv.isi)
  
  res <- list( channels=channels,
              totalspikes=sum(nspikes),
              spikes=spikes, nspikes=nspikes, NCells=length(spikes),
              meanfiringrate=meanfiringrate,
              file=filename,
              ##pos=pos,
              layout=layout,
              rates=rates,
              unit.offsets=unit.offsets,
              rec.time=c(beg, end),
              mean.isi=mean.isi,
              cv.isi = sapply(spikes, cv.isi)
              )
  class(res) <- "mm.s"

  ## Compute the correlation index.
  distance.breaks = c(0, 150, 250, 350, 450, 550, 650, 1000, 2000)
  res$corr = corr.index(res, distance.breaks)

  res

}

make.meafile.cache <- function(dir) {
  ## Remake the file cache.
  ## Search recursively through DIR to find all filenames.
  files <- dir(dir, recursive=TRUE, full.names=TRUE)
  mea.key <- basename(files)
  mea.key <- handle.gz(mea.key)
  
  res <- cbind(mea.key, files)
  res
}

handle.gz <- function(keys) {
  ## Remove any .gz extension from the keys.
  gsub("\\.gz$", "", keys)
}

meafile <- function(file) {
  ## Use the file cache to find where the file is stored.
  ## This saves us having to always use the fullpath to a file.
  row <- which(file==mea.data.files[,1])
  row.n <- length(row)

  ## Do some safety checks.
  if ( row.n ==1) {
    ## return the full filename.
    mea.data.files[row,2]
  } else {
    if (row.n==0) {
      stop(sprintf("Cannot find file %s in mea.data.files\n", file))
    } else {
      stop(sprintf("File %s has %d entries in mea.data.files\n",
                   file, row.n))
    }
  }
}


meatable <- function(file) {
  ## Find the condition table.
  ## Uses global MEA.TABLE.DIR.
  file <- paste(mea.table.dir, file,sep='')
  if (!file.exists(file))
    stop(file, " not found")
  file
}

read.cond.tab <- function(file) {
  dat <- read.csv(file, as.is=TRUE, comment.char='#')


  ## Handle some sanger specific stuff:

  ## "Age (DIV)" is quite cumbersome, so shorten it to "Age"
  long.age <- pmatch("Age..DIV.", names(dat))
  if (length(long.age)==1)
    names(dat)[long.age] = "Age"

  ## strip trailing empty lines.
  empty.lines <- which(dat[,1] == "")
  if ( any(empty.lines) )
    dat <- dat[-empty.lines,]

  ## Remove any rows that should be ignored.
  ignore <- which(dat$Ignore == 1)
  if (any (ignore))

    dat <- dat[-ignore,]
  dat
}

## Poisson surprise method for burst analysis -- L'egendy and Salcman (1985)
## Author: Stephen J Eglen
## Copyright: GPL

s.min = 5                               #threshold on suprise index.

burst.isi.threshold = FALSE             #do we want to use threshold on ISI?

##burst.isi.max = 0.1 #ISI within burst must be smaller than this.

burst.isi.max = NULL                    #set non-null to be the threshold between spikes.

## Threshold for burstiness; how many burst/minute are there to count as a
## bursty unit.
bursty.threshold = 1

######################################################################

burst.info <- c("beg", "len", "SI", "durn", "mean.isis")
burst.info.len = length(burst.info)



spikes.to.bursts <- function(s, method="si") {
  ## Entry function for burst analysis.
  ## Possible methods:
  ## "mi" - maxinterval
  ## "si" - surprise index.
  ## "logisi" - log of the ISI histogram
  
  ncells <- s$NCells

  if (method == "logisi") {
    isi.low <- logisi.compute(s)$Locmin
    logisi.par$isi.low <- isi.low
  }
  
  ##ncells <- 10                           #temp
  allb <- list()
  for (train in 1:ncells) {
    ## cat(sprintf("** analyse train %d\n", train))
    spikes <- s$spikes[[train]]

    bursts = switch(method,
      "mi" = mi.find.bursts(spikes),
      "si" = si.find.bursts(spikes),
      "logisi" = logisi.find.burst(spikes),
      "rs" = rs.find.bursts(spikes),
      stop(method, " : no such method for burst analysis")
    )

    allb[[train]] <- bursts
  }

  allb
}


spikes.to.bursts.surprise <- function(s) {
  ## Wrapper function for surprise method.
  spikes.to.bursts(s, method="si")
}



si.find.bursts <- function(spikes,debug=FALSE) {
  ## For one spike train, find the burst using SI method.
  ## e.g.
  ## find.bursts(s$spikes[[5]])
  ## init.
  nspikes = length(spikes)

  ### OOOOPS!!!!  mean.isi was actually the mean firing rate!
  mean.isi = mean(diff(spikes))
  
  ##mean.isi = nspikes/ (spikes[nspikes] - spikes[1])
  threshold = mean.isi/2

  n = 1

  ## Create a temp array for the storage of the bursts.  Assume that it
  ## will not be longer than Nspikes/3.
  max.bursts <- floor(nspikes/3)
  bursts <- matrix(NA, nrow=max.bursts, ncol=burst.info.len)
  burst <- 0

  ## note, no need to check to end of spike train!
  while ( n < nspikes-2) {              #end condition to check!!!
    if (debug)
      print(n)
    if( ((spikes[n+1] - spikes[n]  ) < threshold) &&
       ((spikes[n+2] - spikes[n+1]) < threshold)) {
      ##res <- find.burst(n, spikes, nspikes, mean.isi, threshold,debug)
      res <- si.find.burst2(n, spikes, nspikes, mean.isi, burst.isi.max,debug)

      if (is.na(res[1])) {
        ## no burst found, just move on one spike.
        n <- n + 1
      } else {
        ## found a burst.
        burst <- burst + 1
        if (burst > max.bursts) {
          print("too many bursts")
          browser()
        }
        bursts[burst,] <- res
        ## WRONG!!! This assumes no phase 2!!!
        ## n <- n + res[2]                 #move to end of burst.
        ## move on to spike after n.
        ##n <- res["n"] + res["i"]
        ## TODO: why does names(res) change?
        ## Could try "0 + res[1] + res[2]"???
        n <- res[1] + res[2]
        names(n) <- NULL                #TODO HHHHH???
        ##browser()
      }
    } else {
      ## no triple-spike.
      n = n + 1
    }
  }

  ## At end of spike train, now truncate bursts to right length.

  if (burst > 0) {
    res <- bursts[1:burst,,drop=FALSE]
    colnames(res) <- burst.info
  } else {
    res <- NA
  }

  res
  
}


si.find.burst2 <- function(n, spikes, nspikes, mean.isi, threshold=NULL,
                        debug=FALSE) {
  ## Find a burst starting at spike N.
  ## Include a better phase 1.


  ## Determine ISI threshold.
  if (is.null(threshold)) 
    isi.thresh = 2 * mean.isi
  else
    isi.thresh = threshold
  
  if (debug) 
    cat(sprintf("** find.burst %d\n", n))
  
  i=3  ## First three spikes are in burst.
  s = surprise(n, i, spikes, nspikes, mean.isi)

  ## Phase 1 - add spikes to the train.
  phase1 = TRUE
  ##browser()

  ## in Phase1, check that we still have spikes to add to the train.
  while( phase1 ) {

    ##printf("phase 1 s %f\n", s);
    
    i.cur = i;

    ## CHECK controls how many spikes we can look ahead until SI is maximised.
    ## This is normally 10, but will be less at the end of the train.
    check = min(10, nspikes-(i+n-1))

    looking = TRUE; okay = FALSE;
    while (looking) {

      if (check==0) {
        ## no more spikes left to check.
        looking=FALSE;
        break;
      }
      check=check-1; i=i+1
      s.new = surprise(n, i, spikes, nspikes, mean.isi)
      if (debug) 
        printf("s.new %f s %f n %d i %d check %d\n", s.new, s, n, i, check)

      if (s.new > s) {
        okay=TRUE; looking=FALSE;
      } else {
        ## See if we should keep adding spikes?
        if ( (spikes[i] - spikes[i-1]) > isi.thresh ) {
          looking = FALSE;
        }
          
      }
    }
    ## No longer checking, see if we found an improvement.
    if (okay) {
      if (s > s.new) {
        ## This should not happen.
        printf("before s %f s.new %f\n", s, s.new)
        browser()
      }
      s = s.new
    } else {
      ## Could not add more spikes onto the end of the train.
      phase1 = FALSE
      i = i.cur
    }
  }


  ## start deleting spikes from the start of the burst.
  phase2 = TRUE
  while(phase2) {
    if (i==3) {
      ## minimum length of a burst must be 3.
      phase2=FALSE
    } else {
      s.new = surprise(n+1, i-1, spikes, nspikes, mean.isi)
      if (debug)
        cat(sprintf("phase 2: n %d i %d s.new %.4f\n", n, i, s.new))        
      if (s.new > s) {
        if (debug) 
          print("in phase 2 acceptance\n")
        n = n+1; i = i-1
        s = s.new
      } else {
        ## removing front spike did not improve SI.
        phase2 = FALSE
      }
    }
  }
  

  ## End of burst detection; accumulate result.
  if ( s > s.min) {


    ## compute the ISIs, and then the mean ISI.
    
    ## Fencepost issue: I is the number of spikes in the burst, so if
    ## the first spike is N, the last spike is at N+I-1, not N+I.
    isis = diff(spikes[n+(0:(i-1))])
    mean.isis = mean(isis)
    
    durn = spikes[n+i-1] - spikes[n]
    res <- c(n=n, i=i, s=s, durn=durn, mean.isis=mean.isis)

    if (debug) 
      print(res)

  } else {
    ## burst did not have high enough SI.
    res <- rep(NA, burst.info.len)
  }
  ##browser()
  res
  
}

surprise <- function(n, i, spikes, nspikes, mean.isi) {
  ## Calculate surprise index for spike train.

  ##stopifnot(n+i <= nspikes)
  dur <- spikes[n+i-1] - spikes[n]
  lambda <- dur / mean.isi
  p <- ppois(i-2, lambda, lower.tail=FALSE)
  s = -log(p)

  s
}


       
######################################################################
## General methods, not just for Surprise Index Method.

calc.burst.summary <- function(s) {
  ## Compute the summary burst information.  Use a separate 
  ## call (write.csv() for example) to write the burst information to file.
  
  allb <- s$allb
  
  ## Create a table of output results.

  channels <- s$channels
  spikes <- as.vector(s$nspikes)

  duration <- s$rec.time[2]  - s$rec.time[1]

  mean.freq <- round(spikes/duration, 3)

  nbursts <- sapply(allb, num.bursts)

  bursts.per.sec <- round(nbursts/duration,3)
  bursts.per.min <- bursts.per.sec * 60


  bursty = ifelse(bursts.per.min >= bursty.threshold, 1, 0)

  durations <- burstinfo(allb, "durn")
  mean.dur <- round(sapply(durations, mean), 3)
  sd.dur <- round(sapply(durations, sd), 3)

  
  
  ##mean.isis <- burstinfo(allb, "mean.isis")
  ##mean.mean.isis <- round(sapply(mean.isis, mean), 3)
  ##sd.mean.isis <- round(sapply(mean.isis, sd), 3)
  ISIs = calc.all.isi(s, allb)
  mean.ISIs = sapply(ISIs, mean)
  sd.ISIs = unlist( sapply(ISIs, sd, na.rm=TRUE))

  
  ns <- burstinfo(allb, "len")
  mean.spikes <- round(sapply(ns, mean), 3)
  sd.spikes   <- round(sapply(ns, sd), 3)
  total.spikes.in.burst <- sapply(ns, sum)
  per.spikes.in.burst <- round(100 *(total.spikes.in.burst / spikes), 3)

  si <- burstinfo(allb, "SI")
  mean.si <- round(sapply(si, mean), 3)


  IBIs <- calc.all.ibi(s, allb)
  mean.IBIs <- sapply(IBIs, mean)
  sd.IBIs <- sapply(IBIs, sd, na.rm=TRUE)
  cv.IBIs <- round(sd.IBIs/ mean.IBIs, 3)
  ## round afterwards...
  mean.IBIs <- round(mean.IBIs, 3); sd.IBIs <- round(sd.IBIs, 3)
  
  df <- data.frame(channels=channels, spikes=spikes, mean.freq=mean.freq,
                   nbursts=nbursts,
                   bursts.per.sec=bursts.per.sec,
                   bursts.per.min=bursts.per.min,
                   bursty = bursty,
                   mean.dur=mean.dur,
                   sd.dur=sd.dur,
                   mean.spikes=mean.spikes,
                   sd.spikes=sd.spikes,
                   per.spikes.in.burst=per.spikes.in.burst,
                   per.spikes.out.burst=round(100.0-per.spikes.in.burst,3),
                   mean.si=mean.si,
                   mean2.isis=mean.ISIs,
                   sd.mean.isis=sd.ISIs,
                   mean.IBIs=mean.IBIs,
                   sd.IBIs=sd.IBIs,
                   cv.IBIs=cv.IBIs
                   )
  ##write.csv(df, file=outfile)

  df

}

mean.burst.summary = function(allb.sum) {
  ## Summarise the burst information.  This does not handle per.spikes.in.burst
  subset = allb.sum[which(allb.sum$bursty==1),]
  
  fields = c("spikes", "mean.dur", "cv.IBI", "bursts.per.min", "per.spikes.in.burst")
  res = rep(0, length(fields)*2)
  names(res) = paste(rep(fields, each=2), c("m", "sd"), sep=".")
  n = 1
  for (field in fields) {
    dat = subset[[field]]
    if (length(dat) > 0 ) {
      mean = mean(dat, na.rm=TRUE); sd = sd(dat, na.rm=TRUE);
    } else {
      mean = sd = NA;
    }
    res[n] = mean; res[n+1] = sd
    n = n +2
  }

  res

}




burstinfo <- function(allb, index) {
  ## Extra some part of the Burst information, for each channel.
  ## index will be the name of one of the columns of burst info.
  ## This is a HELPER function for calc.burst.summary
  sapply(allb, function(b) {
    if (length(b)>1) {
      b[,index]
    } else {
      0
    }
  }, simplify=FALSE)
}
  



calc.ibi <- function(spikes, b) {
  ## Compute the interburst intervals (IBI) for one spike train.
  ## Only valid if more than one burst.

  nburst = num.bursts(b)
  if ( nburst == 0) {
    res = NA                            #no bursts
  } else {
    if (nburst == 1) {
      res = NA                          #cannot compute  IBI w/only 1 burst.
    } else {
      ## find end spike in each burst.
      end = b[,"beg"] + b[,"len"] - 1

      ## for NBURST bursts, there will be NBURST-1 IBIs.
      start.spikes = b[2:nburst,"beg"]
      end.spikes   = end[1:(nburst-1)]
      ## NEX uses a strange definition of IBI -- it counts the time between
      ## the first spike of burst N and the first spike of burst N+1 as the
      ## IBI.  If we want to use that definition, use the following line:
      ##end.spikes   = b[1:(nburst-1),"beg"]
      res = spikes[start.spikes] - spikes[end.spikes]
    }
  }
  res
}

calc.all.ibi <- function (s, allb) {
  ## Compute IBI for all spike trains.
  nchannels <- s$NCells
  IBIs = list()
  for (i in 1:nchannels) {
    IBIs[[i]]  = calc.ibi(s$spikes[[i]], allb[[i]])
  }

  IBIs
}


calc.all.isi <- function (s, allb) {
  ## Compute ISI within bursts for all spike trains.

  calc.isi = function(spikes, b) {
    ## for one spike train, get all ISIs within bursts in that train.
    if (num.bursts(b)==0) {
      return ( NA )
    }

    ## as.vector is needed below in case each burst is of the same
    ## length (in which case an array is returned by apply).  In
    ## normal cases, bursts are of different lengths, so "apply"
    ## returns a list.
    
    isis = as.vector(
      unlist(apply(b, 1,
      function(x) {
        diff(spikes[ x[1]:x[2]])
      } )))
  }
  
  nchannels <- s$NCells
  ISIs = list()
  for (i in 1:nchannels) {
    ISIs[[i]]  = calc.isi(s$spikes[[i]], allb[[i]])
  }

  ISIs
}


num.bursts <- function(b) {
  ## Return the number of bursts found for a spike train.
  if(is.na(b[1]))
    0
  else
    nrow(b)
}

## Plotting code.


plot.burst.info <- function(allb, index, ylab=NULL, max=-1,title='') {
  ## Plot result of burst analysis in a stripchart, one col per channel.
  ## Feature plotted is given by index, e.g. "durn", "len".

  ##plot.channels <- min(length(allb), 70)
  plot.channels <- length(allb)         #plot all channels.
  
  values <- list()
  for (i in 1:plot.channels) {
    b <- allb[[i]]
    if (num.bursts(b)==0) {
      res <- NULL
    } else {
        res <- b[,index]
    }

    ## TODO -- strip out any INF values that creep into SI.
    infs <- which(res==Inf)
    ##print(infs)
    ##print(res)
    if (length(infs)>0)
      res <- res[-infs]
    
    values[[i]] <- res
  }

  if (max>0) {
    values <- sapply(values, pmin, max)
  }
  mins <- min(sapply(values, min), na.rm=TRUE)
  maxs <- max(sapply(values, max), na.rm=TRUE)

  if(is.null(ylab))
    ylab=index

  stripchart(values, method="jitter", pch=20, vert=TRUE,main=title,
             ylim=c(mins,maxs),
             xlab='channel', ylab=ylab)

  ## return value.
  ##values

}

bursts.to.active <- function(bursts, tmin, tmax, dt) {
  ## ??? Not sure if this is used right now.
  nbins = floor((tmax-tmin)/dt)+1

  active = vector(length=nbins)         #default all FALSE.

  nbursts = nrow(bursts)

  for (b in 1:nbursts) {
    burst.start =  spikes[ bursts[b,1]]
    burst.stop =  spikes[ bursts[b,1] + bursts[b,2]]

    cat(sprintf("burst %d from %f to %f\n", b, burst.start, burst.stop))

    start.bin = floor( (burst.start - tmin)/dt) + 1
    stop.bin =  floor( (burst.stop  - tmin)/dt) + 1
    bins = start.bin:stop.bin
    for (bin in bins)
      active[bin] = TRUE
  }
  names(active) <- seq(from=tmin, by=dt, length=nbins)
  active
}


######################################################################
## Old code below.

find.burst <- function(n, spikes, nspikes, mean.isi, threshold,debug) {
  ## Find a burst starting at spike N.

  if (debug) 
    cat(sprintf("** find.burst %d\n", n))
  i=3  ## First three spikes are in burst.
  s = surprise(n, i, spikes, nspikes, mean.isi)
  if (s > s.min) {
    if (debug)
      cat(sprintf("starting phase 1 n %d s %.4f\n", n, s))
    ## Phase 1 - add spikes to the train.
    phase1 = TRUE
    i.asn = n+i-1 #current end index of spike train.

    ## in Phase1, check that we still have spikes to add to the train.
    while( phase1 && (i.asn < nspikes) ) {

      if (!burst.isi.threshold ||
          (( spikes[i.asn+1] - spikes[i.asn]) < burst.isi.max))
        s.new = surprise(n, i+1, spikes, nspikes, mean.isi)
      else
        s.new = 0                       #handles case when ISI > threshold.
      ## TODO -- useful debug info.
      ## cat(sprintf("phase 1: n %d i %d s.new %.4f\n", n, i, s.new))
      if (s.new > s) {
        s = s.new
        i = i+1; i.asn = i.asn+1;
      } else {
        phase1 = FALSE
      }
    }
    ## start deleting spikes from the start of the burst.
    phase2 = TRUE
    while(phase2) {
      s.new = surprise(n+1, i-1, spikes, nspikes, mean.isi)
      if(is.na(s.new))
        browser()
      if (debug)
        cat(sprintf("phase 2: n %d i %d s.new %.4f\n", n, i, s.new))        
      if (s.new > s) {
        if (debug) 
          print("in phase 2 acceptance\n")
        n = n+1; i = i-1
        s = s.new
        if (i==2) {
          ## perhaps set end of phase2 here in this case?
          ## this will happen!!!! TODO
          print("i ==2 in phase 2")
          phase2=FALSE
          ##browser()
        }
      } else {
        phase2 = FALSE
      }
    }

    ## End of burst detection; accumulate result.

    ## compute the ISIs, and then the mean ISI.

    ## Fencepost issue: I is the number of spikes in the burst, so if
    ## the first spike is N, the last spike is at N+I-1, not N+I.
    isis = diff(spikes[n+(0:(i-1))])
    mean.isis = mean(isis)
    
    durn = spikes[n+i-1] - spikes[n]
    res <- c(n=n, i=i, s=s, durn=durn, mean.isis=mean.isis)
  } else {
    res <- rep(NA, burst.info.len)
  }
  ##browser()
  res
  
}

plot.spikes <- function(xlim=NULL, show.bursts=TRUE) {
  ## This requires SPIKES to be defined somwehwere...
  nspikes = length(spikes)
  min.t <- spikes[1]
  max.t <- spikes[nspikes]

  if (is.null(xlim)) {
    xlim <- c(min.t, max.t)
  } 
  plot(NA, xlim=xlim, xlab='time', ylim=c(0,1))
  segments(spikes, rep(0.2, nspikes), spikes, rep(0.8, nspikes))

  
  if (show.bursts) {
    burst.x1 <- spikes[b[,1]]
    burst.x2 <- spikes[b[,1]+ b[,2]]
    burst.y <- rep(0.5, length=length(burst.x1))
    segments(burst.x1, burst.y, burst.x2, burst.y, col='red', lwd=3)
  }
}
## zzz.R --- general functions for loading/unloading package.
## Author: Stephen J Eglen
## Copyright: GPL

.First.lib <- function(lib, pkg) {
  library.dynam("sjemea", pkg, lib)
}

.Last.lib <- function (libpath) {
  ## Run when the package is being unloaded.  This allows us to easily test
  ## packages within same session when dynlib is updates.
  library.dynam.unload("sjemea", libpath)
}
  
