exact.margin.info {truecluster} | R Documentation |
Functions to evaluate the information within a marginal grouping via complexity-penalized entropy or via the exact combinatorial approach.
exact.margin.info(...) approx.margin.info(...)
... |
one or more vectors of group sizes |
Both functions are sensitive to the number of groups but not to the total number of cases.
scalar
Jens Oehlschlägel
margination
, absolute.entropy
, mmcp2I
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)