# truecluster/R/informatorics.R
# Some information theoretic combinatorial functions
# (C) 2003-2007 Dr. Jens Oehlschlägel
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
###########################################################################

#! \name{exact.margin.info}
#! \alias{exact.margin.info}
#! \alias{approx.margin.info}
#! \title{ Univariate "Informatorial" Measures }
#! \description{
#!   Functions to evaluate the information within a marginal grouping via complexity-penalized entropy or via the exact combinatorial approach.
#! }
#! \usage{
#! exact.margin.info(...)
#! approx.margin.info(...)
#! }
#! \arguments{
#!   \item{\dots}{ one or more vectors of group sizes }
#! }
#! \details{
#!   Both functions are sensitive to the number of groups but not to the total number of cases.
#! }
#! \value{
#!   scalar
#! }
#! \author{ Jens Oehlschlägel }
#! \seealso{ \code{\link{margination}}, \code{\link{absolute.entropy}}, \code{\link{mmcp2I}} }
#! \examples{
#!    require(MASS)
#!    what <- "compare at fixed n with increasing k"
#!    cat("\n", what, "\n")
#!    n <- 1024
#!    k <- 1:1024
#!    g <- lapply(k, function(k){g <- rep(n\%/\%k, k);g[0:(n\%\%k)]<-g[0:(n\%\%k)]+1;g})
#!    c1 <- sapply(g, exact.margin.info)
#!    c2 <- sapply(g, approx.margin.info)
#!    eqscplot(c1,c2,type="l", main=what);abline(0,1);arrows(c1[-length(c1)],c2[-length(c1)],c1[-1],c2[-1], length=0.05, col="blue")
#!    matplot(k, cbind(c1, c2), type="l", col=1:2, lty=1:2, ylab="ld(possibilities)/n", main=what)
#!    legend(par("usr")[1],par("usr")[3],c("exact.margin.info","approx.margin.info"), xjust=0, yjust=0, lty=1:2, col=1:2)
#!    i <- (n\%\%k)==0
#!    matpoints(k[i], cbind(c1[i],c2[i]), col=1:2, pch=1:2)
#!
#!    what <- "compare at fixed k with increasing n"
#!    cat("\n", what, "\n")
#!    k <- 100
#!    n <- 100:2000
#!    g <- lapply(n, function(n){g <- rep(n\%/\%k, k);g[1]<-g[1]+n\%\%k;g})
#!    c1 <- sapply(g, exact.margin.info)
#!    c2 <- sapply(g, approx.margin.info)
#!    eqscplot(c1,c2,type="l", main=what);abline(0,1);arrows(c1[-length(c1)],c2[-length(c1)],c1[-1],c2[-1], length=0.05, col="blue")
#!    matplot(n, cbind(c1, c2), type="l", col=1:2, lty=1:2, ylab="ld(possibilities)/n", main=what)
#!    legend(par("usr")[1],par("usr")[3],c("exact.margin.info","approx.margin.info"), xjust=0, yjust=0, lty=1:2, col=1:2)
#!
#!    what <- "compare at fixed k and n with increasing main category (rest outliers)"
#!    cat("\n", what, "\n")
#!    k <- 10
#!    n <- 10:1000
#!    g <- lapply(n, function(n){g <- c(rep(1, k-1), n-9)})
#!    c1 <- sapply(g, exact.margin.info)
#!    c2 <- sapply(g, approx.margin.info)
#!    eqscplot(c1,c2,type="l", main=what);abline(0,1);arrows(c1[-length(c1)],c2[-length(c1)],c1[-1],c2[-1], length=0.05, col="blue")
#!    matplot(n, cbind(c1, c2), type="l", col=1:2, lty=1:2, ylab="ld(possibilities)/n", main=what)
#!    legend(par("usr")[1],par("usr")[3],c("exact.margin.info","approx.margin.info"), xjust=0, yjust=0, lty=1:2, col=1:2)
#!
#!    what <- "compare at fixed k and n with increasing main category (small groups)"
#!    cat("\n", what, "\n")
#!    k <- 10
#!    n <- 500:1500
#!    g <- lapply(n, function(n){g <- c(rep(50, k-1), n-450)})
#!    c1 <- sapply(g, exact.margin.info)
#!    c2 <- sapply(g, approx.margin.info)
#!    eqscplot(c1,c2,type="l", main=what);abline(0,1);arrows(c1[-length(c1)],c2[-length(c1)],c1[-1],c2[-1], length=0.05, col="blue")
#!    matplot(n, cbind(c1, c2), type="l", col=1:2, lty=1:2, ylab="ld(possibilities)/n", main=what)
#!    legend(par("usr")[1],par("usr")[3],c("exact.margin.info","approx.margin.info"), xjust=0, yjust=0, lty=1:2, col=1:2)
#!
#!    what <- "compare at fixed k and n with increasing first category"
#!    cat("\n", what, "\n")
#!    k <- 3
#!    n <- 900
#!    n1 <- 1:300
#!    g <- lapply(n1, function(n1){g <- c(n1, rep((n-n1)\%/\%(k-1),k-1));g[2]<-g[2]+(n-n1)\%\%(k-1);g})
#!    c1 <- sapply(g, exact.margin.info)
#!    c2 <- sapply(g, approx.margin.info)
#!    eqscplot(c1,c2,type="l", main=what);abline(0,1);arrows(c1[-length(c1)],c2[-length(c1)],c1[-1],c2[-1], length=0.05, col="blue")
#!    matplot(n1, cbind(c1, c2), type="l", col=1:2, lty=1:2, ylab="ld(possibilities)/n", main=what)
#!    legend(par("usr")[1],par("usr")[3],c("exact.margin.info","approx.margin.info"), xjust=0, yjust=0, lty=1:2, col=1:2)
#! }
#! \keyword{ math }
#! \keyword{ cluster }


approx.margin.info <- function(...){
 # marginal information penalized for margin complexity
 tab <- c(...)
 n <- sum(tab)
 k <- length(tab)
 p <- tab/n
 entropy <- sum(absolute.entropy(p))
 relativecomplexity <- (2 ^ (entropy) - 1) / (n-1)
 #entropy * (1-(k-1)/(n-1))  # the simple penalty for degrees of freedom
 entropy * (1-relativecomplexity)
}

exact.margin.info <- function(...){
 # exact marginal information via number of possibilities
 tab <- c(...)
 n <- sum(tab)
 ldmargination(tab)/n  # like approx.margin.info normalized for number of cases
}

