# b4winckler/bapp

Add entropy-related functions

• Loading branch information...
1 parent 99dc88e commit 98779db488e7c747ae72a4dfb92228f8f40587fc committed Jun 5, 2012
Showing with 24 additions and 0 deletions.
1. +2 −0 NAMESPACE
2. +22 −0 R/bapp.R
 @@ -3,9 +3,11 @@ export( applyWell, bestPeak, bins, + entropy, estimatePeaks, leftPeak, peakSummary, + partitionEntropy, plotBins, plotPeak, plotPeaks,
 @@ -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.