.packageName <- "spotSegmentation"
"plot.spotseg" <-
function(x, ...) {

col <- NULL
title <- NULL
file <- NULL

plotSpotImage <-
function(z, col = NULL, title = NULL, one = FALSE){

        if (is.null(col)) col <- c("lightyellow", "gray", "black", "yellow",
                                   "blue", "red")

        if (!one) par(mfrow = c(1,1), pty = "m")
       
	nrowz <- nrow(z)
        ncolz <- ncol(z)

        if (!one) {
          PIN <- par()$pin
          if (ncolz < nrowz) 
            par(pin=c(PIN[1]*(ncolz/nrowz), PIN[1]))
          else  
	    par(pin=c(PIN[1], PIN[1]*(nrowz/ncolz)))
        }
	
## reverse the y-axis of z, and transpose so that the image is the same as the raw image
#z[z < 0] <- 0

z[z < 0] <- 3 + abs(z[z < 0])
u <- sort(unique(as.vector(z)))
if (length(col) < max(u)) stop("not enough colors")
L <- length(u)
breaks <- rep(0, L+1)
breaks[1] <- u[1] - .5
breaks[L+1] <- u[L] + .5
if (L > 1) {
  for (i in 2:L) breaks[i] <- (u[i-1] + u[i])/2
}
col <- col[u]

##col <- col[z]
##col <- array(col,dim(z))
##col <- t(col[nrowz:1,])
if (FALSE) {
# show a pixel
z[1,1] <- min(breaks) - .5
col <- c("blue", col)
breaks <- c(min(breaks) - 1, breaks)
}
image(t(z[nrowz:1,]), main=paste(title), xlab="", ylab="", col=col, 
      breaks = breaks, axes=FALSE)

## set some components to NULL to prevent warnings
##      spar[c("cin", "cra", "csi", "cxy", "din", "gamma")] <- NULL
        if (!one) par(pin = PIN)

      invisible()
}

   if (!is.null(file))
     postscript(file, horizontal=FALSE)

   plotSpotImage(x,col,title)    

   invisible()
}

plotBlockImage <-
function(z, title = NULL, one = FALSE){

	nrowz <- nrow(z)
        ncolz <- ncol(z)

        if (!one) {
          par(mfrow = c(1,1), pty = "m")

          PIN <- par()$pin
          if (ncolz < nrowz) 
            par(pin=c(PIN[1]*(ncolz/nrowz), PIN[1]))
          else  
	    par(pin=c(PIN[1], PIN[1]*(nrowz/ncolz)))
        }

	
## reverse the y-axis of z, and transpose so that the image is the same as the raw image
if (any(z < 0)) stop("z has negative components")


image(t(z[nrowz:1,]), main=paste(title), xlab="", ylab="", col=gray((100:0)/100), axes=FALSE)

## set some components to NULL to prevent warnings
##      spar[c("cin", "cra", "csi", "cxy", "din", "gamma")] <- NULL

      if (!one) par(pin = PIN)
      invisible()
}
"spotgrid" <-
function (chan1, chan2, rows = NULL, cols = NULL, span = NULL, 
    show = FALSE) 
{
    signal <- chan1+chan2
    s <- min(signal)
    r <- min(signal[signal > 0])
    if (s <= 0) {
       signal <- signal - s + 1
    }
    else if (r < 1) {
        signal <- signal + 1
    }
    signal <- log(signal)
    spotgridPeaks <- function(series, span = 3, seed = 0) {
        if (!(span%%2)) 
            span <- span + 1
        d <- sort(diff(sort(series)))
        if (!d[1]) {
            d <- d[as.logical(d)][1]
            set.seed(seed)
            noise <- runif(length(series), min = -d/2, max = d/2)
            series <- series + noise
        }
        zmaxcol <- apply(embed(series, span)[, span:1], 1, function(x) {
            if (length(y <- seq(along = x)[x == max(x)]) == 1) 
                y
            else 0
        })
        halfspan <- (span - 1)/2
        c(rep(FALSE, halfspan), zmaxcol == 1 + halfspan)
    }
    isum <- colSums(signal)
    gridcomp <- function(isum, nspots, span) {
        N <- length(isum)
        if (!(span%%2)) 
            span <- span + 1
        Peaks <- spotgridPeaks(isum, span)
        Vales <- spotgridPeaks(-isum, span)
        iPeaks <- (1:N)[Peaks]
        iVales <- (1:N)[Vales]
        nPeaks <- length(iPeaks)
        nVales <- length(iVales)
        if (FALSE) {
            plot(1:N, isum, type = "l", xlab = "", ylab = "")
            points(iPeaks, isum[iPeaks], pch = "P")
            points(iVales, isum[iVales], pch = "V")
        }
        V <- rep(0, nPeaks - 1)
        for (i in 2:nPeaks) {
            K <- iPeaks[i - 1]:iPeaks[i]
            I <- isum[K]
            J <- K[I == min(I)]
            if (length(J) > 1) {
                M <- match(J, iVales, nomatch = 0)
                J <- if (any(M)) 
                  (iVales[M])[1]
                else J[1]
            }
            V[i - 1] <- J
        }
        P <- rep(0, nVales - 1)
        for (i in 2:nVales) {
            K <- iVales[i - 1]:iVales[i]
            I <- isum[K]
            J <- K[I == max(I)]
            if (length(J) > 1) {
                M <- match(J, iPeaks, nomatch = 0)
                J <- if (any(M)) 
                  (iPeaks[M])[1]
                else J[1]
            }
            P[i - 1] <- J
        }
        iPeaks <- unique(sort(c(iPeaks, P)))
        iVales <- unique(sort(c(iVales, V)))
        nPeaks <- length(iPeaks)
        nVales <- length(iVales)
        if (nPeaks < nspots) {
##            warning("fewer peaks than spots")
            nspots <- nPeaks
        }
        peakvals <- rep(0, nPeaks)
        for (i in 1:nPeaks) {
            m <- iPeaks[i]
            J <- iVales[iVales < m]
            K <- iVales[iVales > m]
            lSum <- rSum <- 0
            d <- 0
            if (length(J)) {
                lSum <- isum[J[length(J)]]
                d <- d + 1
            }
            if (length(K)) {
                rSum <- isum[K[1]]
                d <- d + 1
            }
            peakvals[i] <- isum[m] - (lSum + rSum)/d
        }
        i <- 0
        smax <- sum(sort(peakvals))
        k <- nPeaks - nspots
        if (k) {
            smax <- s <- smax - sum(peakvals[-(1:nspots)])
            for (j in 1:k) {
                d <- (peakvals[j + nspots] - peakvals[j])
                s <- s + d
                if (s > smax) {
                  smax <- s
                  i <- j
                }
            }
        }
        span <- max(span, max(diff(iPeaks[i + 1:nspots])))
        j <- 1
        while (TRUE) {
            if (iVales[j] > iPeaks[i + 1] && iVales[j] < iPeaks[i + 
                2]) 
                break
            j <- j + 1
        }
        index <- rep(0, nspots + 1)
        index[2:nspots] <- iVales[j:(j + nspots - 2)]
        halfspan <- floor(span/2)
        index[1] <- iPeaks[i + 1] - halfspan
        index[nspots + 1] <- iPeaks[nspots + i] + halfspan
        if (FALSE) {
            par(ask = T)
            plot(1:N, isum, type = "l", xlab = "", ylab = "")
            points(iPeaks, isum[iPeaks], pch = "P")
            points(iVales, isum[iVales], pch = "V")
            abline(v = index[1], col = "red")
            abline(v = index[length(index)], col = "red")
            for (i in 1:length(index)) {
                abline(v = index[i], col = "red")
            }
        }
        index
    }
    if (show) {
        plotBlockImage(signal)
    }
    rowcut <- colcut <- NA
    if (!is.null(rows) && rows > 0) {
        if (is.null(span)) {
            span <- floor(nrow(signal)/rows)
            if (!(span%%2)) 
                span <- span - 1
        }
        rowcut <- gridcomp(rowSums(signal), rows, if (length(span) == 
            2) 
            span[1]
        else span)
        if (length(rowcut) < rows+1) {
          span <- min(diff(rowcut))
          rowcut <- gridcomp( rowSums(signal), rows, span) 
        }
        if (length(rowcut) < rows+1) warning("fewer peaks than spots")
        if (show && (is.null(cols) || cols <= 0)) {
            chan1[] <- 0
            chan1[rowcut, ] <- 1
            contour(z = t(chan1[nrow(signal):1, ]), nlevels = 1, 
                levels = 1, drawlabels = FALSE, col = "red", 
                add = TRUE)
        }
    }
    if (!is.null(cols) && cols > 0) {
        if (is.null(span)) {
            span <- floor(ncol(signal)/cols)
            if (!(span%%2)) 
                span <- span - 1
        }
        colcut <- gridcomp(colSums(signal), cols, if (length(span) == 
            2) 
            span[2]
        else span)
        if (length(colcut) < cols+1) {
          span <- min(diff(colcut))
          colcut <- gridcomp( colSums(signal), cols, span) 
        }
        if (length(colcut) < cols+1) warning("fewer peaks than spots")
        if (show && (is.null(rows) || rows <= 0)) {
            chan1[] <- 0
            chan1[, colcut] <- 1
            contour(z = t(chan1[nrow(signal):1, ]), nlevels = 1, 
                levels = 1, drawlabels = FALSE, col = "red", 
                add = TRUE)
        }
    }
    if (show && !is.na(rowcut) && !is.na(colcut)) {
        chan1[] <- 0
        chan1[rowcut, colcut[1]:colcut[length(colcut)]] <- 1
        chan1[rowcut[1]:rowcut[length(rowcut)], colcut] <- 1
        contour(z = t(chan1[nrow(chan1):1, ]), nlevels = 1, levels = 1, 
            drawlabels = FALSE, col = "red", add = TRUE)
    }
    list(rowcut = rowcut, colcut = colcut)
}

"spotseg" <-
function (chan1, chan2, rowcut, colcut, R = NULL, C = NULL, threshold = 100, 
    hc = FALSE, show = FALSE) 
{
    spotseg1 <- function(spot, i, j, threshold = 100, ccl = TRUE, 
        hc = FALSE, show = FALSE) {
        dis <- function(spot, k) {
            L <- spot == k
            n <- sum(as.numeric(L))
            IJ <- matrix(NA, n, 2)
            IJ[, 1] <- ((row(spot) - (nrow(spot) + 1)/2))[L]
            IJ[, 2] <- ((col(spot) - (ncol(spot) + 1)/2))[L]
            sum(apply(IJ, 1, vecnorm))/n
        }
        cir <- function(spot, k) {
            L <- spot == k
            n <- sum(as.numeric(L))
            IJ <- matrix(NA, n, 2)
            IJ[, 1] <- row(spot)[L]
            IJ[, 2] <- col(spot)[L]
            IJ <- sweep(IJ, MARGIN = 2, FUN = "-", STATS = colMeans(IJ))
            d <- apply(IJ, 1, vecnorm)
            sum(as.numeric(d <= sqrt(n/pi)))/n
        }
        orderBYmean <- function(summary, q) {
            cl <- summary$classification
            u <- sort(unique(cl))
            G <- length(u)
            mu <- rep(NA, G)
            names(mu) <- as.character(u)
            for (k in 1:G) {
                n <- sum(as.numeric(cl == u[k]))
                mu[k] <- sum(spot[cl == u[k]]/n)
            }
            ord <- order(mu)
            cl <- -cl
            for (k in 1:G) cl[cl == -u[k]] <- ord[k]
            if (G == 2) {
                cl[cl == 2] <- 3
                nm <- names(mu)
                nm[nm == "2"] <- "3"
                names(mu) <- nm
            }
            mu <- mu[ord]
            list(cl = cl, mu = mu)
        }
        concomp <- function(binaryImage, nNeighbors = 4) {
            if (nNeighbors != 4 && nNeighbors != 8) 
                stop("4 or 8 neighbors")
            nrowImage <- nrow(binaryImage)
            ncolImage <- ncol(binaryImage)
            nPixels <- nrowImage * ncolImage
            M <- sum(as.numeric(binaryImage))
            K <- (1:nPixels)[as.logical(binaryImage)]
            binaryImage[K] <- 1:M
            Krev <- rev(K)
            change <- TRUE
            while (change) {
                change <- FALSE
                for (k in K) {
                  j <- ceiling(k/nrowImage)
                  i <- k - nrowImage * (j - 1)
                  l <- binaryImage[i, j]
                  if (nNeighbors == 4) {
                    iPairs <- c(i, i - 1, i, i + 1, i)
                    jPairs <- c(j - 1, j, j, j, j + 1)
                  }
                  else {
                    iPairs <- c(i - 1, i, i + 1, i - 1, i, i + 
                      1, i - 1, i, i + 1)
                    jPairs <- c(j - 1, j - 1, j - 1, j, j, j, 
                      j + 1, j + 1, j + 1)
                  }
                  I <- (iPairs > 0 & iPairs <= nrowImage)
                  I <- (jPairs > 0 & jPairs <= ncolImage) & I
                  N <- ((jPairs - 1) * nrowImage + iPairs)[I]
                  m <- min((binaryImage[N])[as.logical(binaryImage[N])])
                  binaryImage[i, j] <- m
                  change <- change || m != l
                }
                for (k in Krev) {
                  j <- ceiling(k/nrowImage)
                  i <- k - nrowImage * (j - 1)
                  l <- binaryImage[i, j]
                  if (nNeighbors == 4) {
                    iPairs <- c(i, i - 1, i, i + 1, i)
                    jPairs <- c(j - 1, j, j, j, j + 1)
                  }
                  else {
                    iPairs <- c(i - 1, i, i + 1, i - 1, i, i + 
                      1, i - 1, i, i + 1)
                    jPairs <- c(j - 1, j - 1, j - 1, j, j, j, 
                      j + 1, j + 1, j + 1)
                  }
                  I <- (iPairs > 0 & iPairs <= nrowImage)
                  I <- (jPairs > 0 & jPairs <= ncolImage) & I
                  N <- ((jPairs - 1) * nrowImage + iPairs)[I]
                  m <- min((binaryImage[N])[as.logical(binaryImage[N])])
                  binaryImage[i, j] <- m
                  change <- change || m != l
                }
            }
            tbl <- sort(unique(binaryImage[K]))
            I <- 2:length(tbl)
            for (i in I) binaryImage[binaryImage == tbl[i]] <- i
            binaryImage
        }
        plotSpotImage <- function(z, col = NULL, title = NULL, 
            one = FALSE) {
            if (is.null(col)) 
                col <- c("lightyellow", "gray", "black", "yellow", 
                  "blue", "red")
            if (!one) 
                par(mfrow = c(1, 1), pty = "m")
            nrowz <- nrow(z)
            ncolz <- ncol(z)
            if (!one) {
                PIN <- par()$pin
                if (ncolz < nrowz) 
                  par(pin = c(PIN[1] * (ncolz/nrowz), PIN[1]))
                else par(pin = c(PIN[1], PIN[1] * (nrowz/ncolz)))
            }
            z[z < 0] <- 3 + abs(z[z < 0])
            u <- sort(unique(as.vector(z)))
            if (length(col) < max(u)) 
                stop("not enough colors")
            L <- length(u)
            breaks <- rep(0, L + 1)
            breaks[1] <- u[1] - 0.5
            breaks[L + 1] <- u[L] + 0.5
            if (L > 1) {
                for (i in 2:L) breaks[i] <- (u[i - 1] + u[i])/2
            }
            col <- col[u]
            if (FALSE) {
                z[1, 1] <- min(breaks) - 0.5
                col <- c("blue", col)
                breaks <- c(min(breaks) - 1, breaks)
            }
            image(t(z[nrowz:1, ]), main = paste(title), xlab = "", 
                ylab = "", col = col, breaks = breaks, axes = FALSE)
            if (!one) 
                par(pin = PIN)
            invisible()
        }
        if (show) 
            plotBlockImage(sqrt(spot), title = "spot image", 
                one = TRUE)
        spot <- as.matrix(spot)
        if (hc) {
            BIC <- mclustBIC(as.vector(spot), G = 1:3, 
            initialization = list(hcPairs = hcE(data = as.vector(spot))))
        }
        else {
            BIC <- mclustBIC(as.vector(spot), G = 1:3)
        }
        spot[] <- orderBYmean(summary(BIC, 
                              data = as.vector(spot)), q)$cl
        G <- max(as.vector(spot))
        K <- unique(as.vector(spot))
        G <- length(K)
        if (G == 1) {
            spot[] <- 1
            if (show) 
                plotSpotImage(spot, title = "after clustering and final labeling", 
                  one = TRUE)
            if (show) 
                frame()
            if (show) 
                frame()
            if (show) 
                frame()
            return(spot)
        }
        if (show) 
            plotSpotImage(spot, title = "after clustering", one = TRUE)
        if (ccl) {
            for (k in K) {
                CC <- concomp(spot == k)
                tabl <- table(CC)[-1]
                namt <- names(tabl)
                M <- as.numeric(namt[tabl >= threshold])
                spot[spot == k & !as.logical(match(CC, M, nomatch = 0))] <- -k
            }
        }
        if (show) 
            plotSpotImage(spot, title = "after CC thresholding", 
                one = TRUE)
        if (any(spot > 0)) {
            tab <- table(spot[spot > 0])
            lab <- as.numeric(names(tab))
            if (length(tab) == 1) {
                if (lab == 2) 
                  spot[spot == 2] <- 1
            }
            else {
                fground <- lab[length(lab)]
                bground <- lab[1]
                if (fground <= bground) 
                  stop("thresholding bug")
                spot[spot > 0 & spot != fground & spot != bground] <- -9
                spot[spot == fground] <- 3
                spot[spot == bground] <- 1
            }
        }
        spot[spot < -1] <- 2
        spot[spot == -1] <- 1
        dis1 <- dis3 <- 0
        if (any(spot == 3)) {
            dis1 <- dis(spot, 1)
            dis3 <- dis(spot, 3)
            if (dis3 > dis1) 
                spot[spot == 3] <- 2
        }
        if (show) 
            plotSpotImage(spot, title = "final labeling", one = TRUE)
        spot
    }
    if (show) {
        par(mfrow = c(2, 2), pty = "m")
        if (length(R) == 1 || length(C) == 1) {
            par(ask = FALSE)
        }
        else {
            par(ask = TRUE)
        }
    }
    else {
        par(mfrow = c(1, 1), pty = "m")
    }
    m <- length(rowcut)
    n <- length(colcut)
    s <- chan1 + chan2
    L <- list(channel1 = list(foreground = list(mean = matrix(NA, 
        m, n), median = matrix(NA, m, n)), background = list(mean = matrix(NA, 
        m, n), median = matrix(NA, m, n))), channel2 = list(foreground = list(mean = matrix(NA, 
        m, n), median = matrix(NA, m, n)), background = list(mean = matrix(NA, 
        m, n), median = matrix(NA, m, n))))
    R <- if (is.null(R)) 
        2:m
    else R + 1
    C <- if (is.null(C)) 
        2:n
    else C + 1
    for (i in R) {
        I <- rowcut[i - 1]:(rowcut[i] - 1)
        for (j in C) {
            J <- colcut[j - 1]:(colcut[j] - 1)
            s[I, J] <- spotseg1(s[I, J], i = i - 1, j = j - 1, 
                threshold = threshold, hc = hc, show = show)
            if (show) {
                print(c(i, j) - 1)
                if (FALSE) {
                  pick <- menu("continue;0:exit", title = NULL)
                  if (!pick) 
                    return(NULL)
                }
            }
            fore <- s[I, J] == 3
            back <- s[I, J] == 1
            if (any(fore)) {
                L$channel1$foreground$mean[i, j] <- mean(chan1[I, 
                  J][fore], na.rm = TRUE)
                L$channel1$foreground$median[i, j] <- median(chan1[I, 
                  J][fore], na.rm = TRUE)
                L$channel2$foreground$mean[i, j] <- mean(chan2[I, 
                  J][fore], na.rm = TRUE)
                L$channel2$foreground$median[i, j] <- median(chan2[I, 
                  J][fore], na.rm = TRUE)
            }
            if (any(back)) {
                L$channel1$background$mean[i, j] <- mean(chan1[I, 
                  J][back], na.rm = TRUE)
                L$channel1$background$median[i, j] <- median(chan1[I, 
                  J][back], na.rm = TRUE)
                L$channel2$background$mean[i, j] <- mean(chan2[I, 
                  J][back], na.rm = TRUE)
                L$channel2$background$median[i, j] <- median(chan2[I, 
                  J][back], na.rm = TRUE)
            }
        }
    }
    L$channel1$foreground$mean <- L$channel1$foreground$mean[2:m, 
        2:n]
    L$channel1$foreground$median <- L$channel1$foreground$median[2:m, 
        2:n]
    L$channel1$background$mean <- L$channel1$background$mean[2:m, 
        2:n]
    L$channel1$background$median <- L$channel1$background$median[2:m, 
        2:n]
    L$channel2$foreground$mean <- L$channel2$foreground$mean[2:m, 
        2:n]
    L$channel2$foreground$median <- L$channel2$foreground$median[2:m, 
        2:n]
    L$channel2$background$mean <- L$channel2$background$mean[2:m, 
        2:n]
    L$channel2$background$median <- L$channel2$background$median[2:m, 
        2:n]
    s <- s[rowcut[1]:(rowcut[m] - 1), colcut[1]:(colcut[n] - 
        1)]
    structure(s, summaryStatistics = L, class = "spotseg")
}

"summary.spotseg" <-
function (object, ...) 
{
attr(object,"summaryStatistics")
}
