Permalink
Browse files

Add entropy-related functions

  • Loading branch information...
1 parent 99dc88e commit 98779db488e7c747ae72a4dfb92228f8f40587fc @b4winckler committed Jun 5, 2012
Showing with 24 additions and 0 deletions.
  1. +2 −0 NAMESPACE
  2. +22 −0 R/bapp.R
View
@@ -3,9 +3,11 @@ export(
applyWell,
bestPeak,
bins,
+ entropy,
estimatePeaks,
leftPeak,
peakSummary,
+ partitionEntropy,
plotBins,
plotPeak,
plotPeaks,
View
@@ -72,3 +72,25 @@ randomProfile <- function(binCount, binSize)
{
data.frame(x=rep(1:binCount, binSize), y=rnorm(binCount*binSize))
}
+
+# Compute entropy of a discrete probability distribution function (pdf). If
+# 'relative=TRUE' then the result is normalized by the maximum entropy for a
+# pdf on 'n' elements, where 'n' is the number of positive entries in 'p'. The
+# effect of this normalization is that the returned value lies in the unit
+# interval.
+entropy <- function(p, relative=FALSE)
+{
+ q <- p[p > 0 & !is.na(p)]
+ n <- length(q)
+ ifelse(n > 1, -sum(q * log2(q)) / ifelse(relative, log2(n), 1), 0)
+}
+
+# Compute entropy for a partition of 'x' with the given breaks. The 'breaks'
+# argument is documented in the help for 'cut'. If 'relative=TRUE' then the
+# entropy is normalized to lie within the unit interval.
+partitionEntropy <- function(x, breaks, ...)
+{
+ partition <- cut(x, breaks=breaks)
+ freq <- tapply(x, partition, length)
+ entropy(freq / sum(freq, na.rm=TRUE), ...)
+}

0 comments on commit 98779db

Please sign in to comment.