# Usage:
#   pmm.confidence( fit, classes, use.scaled=FALSE )
#
# Arguments:
#   fit: a mixture model fit created using the flexmix library
#
#   classes: a vector of numeric class labels consisting of 0 or 1
#
#   use.scaled: logical; if TRUE then scaled posterior probabilities
#               are used (total probability of being assigned to
#               a component is scaled to 1)
#
#   separate: logical; if TRUE then the components must separate the
#             two classes (i.e. 3 components A,B,C where A>B>C must
#             be arranged AB|C or A|BC, not AC|B)
#
# Value:
#   'pmm.confidence' gives the confidence that the fitted mixture 
#   model components can differentiate between the sample types.
#   The result is a list containing a confidence score for 
#   group 0 ('prob0'), group 1 ('prob1'), and the mean of the 
#   two ('prob').
#
# Examples:
#
#   # generate data for example fit
#   counts <- c( rpois( 20, 20 ), rpois( 20, 40 ) )
#   sizes  <- rep( 100000, 40 )
#   fit    <- flexmix( counts ~ 1, model=FLXglm(family="poisson",offset=log(sizes)), k=2 )
#
#   classes <- c( 0,0,0,0,1,1,1,1 )
#   scores  <- pmm.confidence( fit, classes )
#   cat( "conf(group 0)    =", scores$prob0, "\n" )
#   cat( "conf(group 1)    =", scores$prob1, "\n" )
#   cat( "conf(both groups)=", scores$prob,  "\n" )
#
"pmm.confidence" <- function( fit, classes, use.scaled=FALSE, separate=TRUE ) {

  if( missing(fit) ) stop( "must supply flexmix fit" )
  if( missing(classes) ) stop( "must supply classes" )

  if( max(classes) > 1 ) stop( "pmm.confidence currently supports only two classes" )

  posterior <- NULL
  if( use.scaled ) posterior <- attributes(fit)$posterior$scaled
  else posterior <- attributes(fit)$posterior$unscaled

  k <- attributes(fit)$k

  if( k < 2 ) stop( "can't check confidence with only 1 component" )

  # make classes 1-indexed
  #classes <- classes + 1

  mat <- matrix( nrow=length(unique(classes)), ncol=k )

  thetas <- array( dim=k )
  
  for( i in 1:k ) {
    probs <- as.numeric( posterior[,i] )
    thetas[i] <- parameters( fit, component=i )$coef
    for( j in 0:max(classes) ) {
      mat[(j+1),i] <- sum( probs[which(classes==j)] )
    }
  }

  combins <- list()
  iter <- 1
  for( i in 1:(k-1) ) {
    tmp <- combn( 1:k, m=i )
    if( is.null( tmp ) || is.na( tmp ) ) {
      cat( "k=",k,"\n" )
      cat( "m=",i,"\n" )
    }
    for( j in 1:ncol(tmp) ) {
      combins[[iter]] <- as.numeric( tmp[,j] )
      iter <- iter + 1
    }
  }

  probs <- matrix( nrow=length(combins), ncol=3 )
  for( i in 1:length(combins) ) {
	
    # check that components separate the classes
    if( separate ) {

      components1 <- combins[[i]]
      components2 <- which( !(1:k %in% combins[[i]]) )

      if( !( min(thetas[components1]) > max(thetas[components2]) ||
             max(thetas[components1]) < min(thetas[components2]) ) ) {
        next
      }

    }

    sum.pp0  <- sum( mat[1,combins[[i]]] )
    sum.pp0a <- sum( mat[1,which(!(1:k %in% combins[[i]]))] )
    sum.pp1 <- sum( mat[2,combins[[i]]] )
    sum.pp1a  <- sum( mat[2,which(!(1:k %in% combins[[i]]))] )
    sum.all  <- sum.pp0 + sum.pp1

    p0 <- sum.pp0  / ( sum.pp0+sum.pp1 )
    p1 <- sum.pp1a / ( sum.pp1a+sum.pp0a )

    probs[i,1] <- p0
    probs[i,2] <- p1
    probs[i,3] <- (p0+p1)/2

  }

  # which configuration of components had best
  # confidence score?
  idx <- which( probs[,3] == max(probs[,3], na.rm=TRUE) )[1]

  results <- list()
  results$prob0 <- as.numeric( probs[idx,1] )
  results$prob1 <- as.numeric( probs[idx,2] )
  results$prob  <- as.numeric( probs[idx,3] )

  results$components0 <- as.numeric( combins[[idx]] )
  results$components1 <- as.numeric( which( !( 1:k %in% combins[[idx]] ) ) )

  results
  
}