1
$\begingroup$

For a numerical sanity check, I need to sample random sequences of $n$ positive numbers adding up to 1, and having a high chance of observing both high entropy and low entropy sequences. Compute the entropy by treating sequence as a discrete probability distribution.

Ideally, the histogram of sampled sequence entropies would approach uniform distribution.

Can someone suggest a way to do this in Mathematica? Here's a naive generation method, showing non-uniform entropy histogram, and the kind of histogram I would like to see.

n = 10;
s = 10000;
normalize[seq_] := seq/Total@seq; 
sequences = 
  normalize /@ RandomVariate[UniformDistribution[], {s, n}];
entropy[seq_] := -Total[# Log[#] & /@ seq];
Histogram[entropy /@ sequences, PlotLabel -> "observed"]
Histogram[RandomVariate[UniformDistribution[], s], 
 PlotLabel -> "desired"]

enter image description here

$\endgroup$
7
  • $\begingroup$ Mathematica already has Entropy so you don't need to define it yourself. $\endgroup$
    – flinty
    Jun 23, 2021 at 16:45
  • $\begingroup$ What do you mean by "ideally"? If there is some theoretical reason, that clearly flies in the face of the observed data given the definition of entropy you're using. Also, the distribution you get depends on how one creates sequences as there are many ways to get random vectors that sum to 1. For example: sequences = RandomVariate[DirichletDistribution[ConstantArray[1, n]], s]; sequences = Flatten[{#, 1 - Total[#]}] & /@ sequences; Histogram[entropy /@ sequences]. $\endgroup$
    – JimB
    Jun 23, 2021 at 17:48
  • $\begingroup$ What is a typical value of n? The largest and smallest values of n you plan to consider? $\endgroup$
    – mikado
    Jun 23, 2021 at 17:52
  • $\begingroup$ @mikado n=1000 is the largest one I would consider, but I would settle for smaller values as well. $\endgroup$ Jun 23, 2021 at 18:17
  • $\begingroup$ One potential approach could be generate a set of equidistant points in an n-dimensional simplex, weigh each point by entropy, then resample $\endgroup$ Jun 23, 2021 at 19:32

1 Answer 1

1
$\begingroup$

If the objective is to get a collection of vectors with a reasonably wide range of entropy values and have the distribution of those entropy values be approximately uniform, then you can first do almost exactly as you did:

n = 10;
s = 10000;
normalize[seq_] := seq/Total@seq; 
SeedRandom[12345];
sequences = normalize /@ RandomVariate[UniformDistribution[], {s, n}];
entropy[seq_] := -Total[# Log[#] & /@ seq];
data = entropy /@ sequences;
SmoothHistogram[data, Automatic, "PDF", PlotLabel -> "observed"]

Smooth histogram of entropy values

(Note that it's time to retire the histogram especially when sample sizes are large.)

Now we ignore the histogram and sample the entropy values in a "uniform" manner:

(* Generate uniformly random entropy values between the min and max of the observed values *)
eValues = RandomVariate[UniformDistribution[MinMax[data]], 10000];

(* Join the entropy values with the sequences *)
data = Transpose[{data, sequences}];

(* Initialize array to hold entropy values and associated sequence *)
newData = ConstantArray[0, Length[eValues]];

(* Generate new data (sequences) with a wide range of entropy values *)
Do[newData[[i]] = {eValues[[i]], SelectFirst[data, #[[1]] > eValues[[i]] &]}, {i, Length[eValues]}]
SmoothHistogram[newData[[All, 1]], {Automatic, {"Bounded", {0, Log[n]}, "Gaussian"}}, "PDF"]

Relatively uniform distribution of entropy values

Now ignoring the distribution of the original entropy values makes no sense if one is attempting to make inferences about entropy values as they were originally generated. But if just a wide range of test vectors need to be generated that have a roughly uniform distribution, then this technique will do that.

Addition

From the comment to obtain an assortment of vectors with lower entropy values one might use the Dirichlet distribution appropriately parameterized. The elements by definition sum to 1 so there's no messing around with normalizing. The lowest entropy is zero (assuming that 0*Log[0] is defined as zero) so vectors should look closer to {1,0,0,...,0} than {1,1,...,1}/n.

n = 10;
s = 10000; 
sequences =  RandomVariate[DirichletDistribution[Flatten[{{n^2}, ConstantArray[1, n - 1]}]], s];
entropy[seq_] := -Total[# Log[#] & /@ seq];
lowE = entropy /@ sequences;
SmoothHistogram[lowE, Automatic, "PDF", PlotLabel -> "observed"]

Smooth histogram of lower entropy values

More "mid-range" entropy values could be found by

s = 10000; 
sequences = RandomVariate[DirichletDistribution[Flatten[{{n, n}, ConstantArray[1, n - 2]}]], s];
entropy[seq_] := -Total[# Log[#] & /@ seq];
midE = entropy /@ sequences;
SmoothHistogram[midE, Automatic, "PDF", PlotLabel -> "observed"]

Alternative Dirichlet distribution smoothed histogram of entropies

All of the datasets could be joined and then sampled "as if uniform" as done previously.

$\endgroup$
2
  • $\begingroup$ @YarsolovBulatov Too weird an answer? This approach is at least vaguely related to importance sampling: statweb.stanford.edu/~owen/mc/Ch-var-is.pdf. $\endgroup$
    – JimB
    Jun 24, 2021 at 18:15
  • $\begingroup$ Neat resampling trick with SelectFirst. The only downside is that the smallest entropy obtained in a sample of 10k from Uniform might be considerably larger than smallest possible entropy $\endgroup$ Jun 24, 2021 at 21:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.