12
\$\begingroup\$

I once needed to write a function that calculates the block entropy of a given symbol series for a given block size and was surprised how short the result was. Thus I am challenging you to codegolf such a function. I am not telling you what I did for now (and in which language), but I will in a week or so, if nobody came up with the same or better ideas first.

Definition of the block entropy:

Given a symbol sequence A = A_1, …, A_n and a block size m:

  • A block of size m is a segment of m consecutive elements of the symbol sequence, i.e., A_i, …, A_(i+m−1) for any appropriate i.
  • If x is a symbol sequence of size m, N(x) denotes the number of blocks of A which are identical to x.
  • p(x) is the probability that a block from A is identical to a symbol sequence x of size m, i.e., p(x) = N(x)/(n−m+1)
  • Finally, the block entropy for block size m of A is the average of −log(p(x)) over all blocks x of size m in A or (which is equivalent) the sum of −p(x)·log(p(x)) over every x of size m occurring in A. (You can choose any reasonable logarithm you want.)

Restricions and clarifications:

  • Your function should take the symbol sequence A as well as the block size m as an argument.
  • You may assume that the symbols are represented as zero-based integers or in another convenient format.
  • Your program should be capable of taking any reasonable argument in theory and in reality should be able to calculate the example case (see below) on a standard computer.
  • Built-in functions and libraries are allowed, as long as they do not perform big portions of the procedure in one call, i.e., extracting all blocks of size m from A, counting the number of occurrences of a given block x or calculating the entropies from a sequence of p values – you have to do those things yourself.

Test:

[2, 3, 4, 1, 2, 3, 0, 0, 3, 2, 3, 0, 2, 2, 4, 4, 4, 1, 1, 1, 0, 4, 1,
2, 2, 4, 0, 1, 2, 3, 0, 2, 3, 2, 3, 2, 0, 1, 3, 4, 4, 0, 2, 1, 4, 3,
0, 2, 4, 1, 0, 4, 0, 0, 2, 2, 0, 2, 3, 0, 0, 4, 4, 2, 3, 1, 3, 1, 1,
3, 1, 3, 1, 0, 0, 2, 2, 4, 0, 3, 2, 2, 3, 0, 3, 3, 0, 0, 4, 4, 1, 0,
2, 3, 0, 0, 1, 4, 4, 3]

The first block entropies of this sequence are (for the natural logarithm):

  • m = 1: 1.599
  • m = 2: 3.065
  • m = 3: 4.067
  • m = 4: 4.412
  • m = 5: 4.535
  • m = 6: 4.554
\$\endgroup\$
  • \$\begingroup\$ @m.buettner: If you consider your solution borderline regarding my rules, you could still give it a try – I really only want to avoid solutions along the lines of entropy(probabilities(blocks(A,m))). \$\endgroup\$ – Wrzlprmft Mar 16 '14 at 14:18
  • \$\begingroup\$ Isn't it customary to use log base 2 for this? \$\endgroup\$ – Jonathan Van Matre Mar 16 '14 at 15:04
  • \$\begingroup\$ The values for the entropy at the end are positive, but the logarithm of a probability is negative or zero. Therefore a negative sign is missing in the formula for the entropy. \$\endgroup\$ – Heiko Oberdiek Mar 16 '14 at 15:38
  • \$\begingroup\$ @JonathanVanMatre: As far as I know, it depends on the discipline which is the most-used pased of the logarithm. Anyway, it should not matter that much for the challenge and thus you can use whatever base reasonable you want. \$\endgroup\$ – Wrzlprmft Mar 16 '14 at 16:49
  • \$\begingroup\$ @HeikoOberdiek: Thanks, I forgot that. \$\endgroup\$ – Wrzlprmft Mar 16 '14 at 16:52
6
\$\begingroup\$

Mathematica - 81 78 75 72 67 65 62 56 bytes

I haven't golfed anything in Mathematica before, so I suppose there's room for improvement. This one doesn't quite conform to the rules due to the Partition and Tally functions, but it's quite neat so I thought I'd post it anyway.

f=N@Tr[-Log[p=#2/Length@b&@@@Tally[b=##~Partition~1]]p]&

This works with any set of symbols, and can be used like

sequence = {2, 3, 4, 1, 2, 3, 0, 0, 3, 2, 3, 0, 2, 2, 4, 4, 4, 1, 1, 
   1, 0, 4, 1, 2, 2, 4, 0, 1, 2, 3, 0, 2, 3, 2, 3, 2, 0, 1, 3, 4, 4, 
   0, 2, 1, 4, 3, 0, 2, 4, 1, 0, 4, 0, 0, 2, 2, 0, 2, 3, 0, 0, 4, 4, 
   2, 3, 1, 3, 1, 1, 3, 1, 3, 1, 0, 0, 2, 2, 4, 0, 3, 2, 2, 3, 0, 3, 
   3, 0, 0, 4, 4, 1, 0, 2, 3, 0, 0, 1, 4, 4, 3};
f[sequence, 3]

> 4.06663

Here is a somewhat ungolfed version:

f[sequence_, m_] := (
    blocks = Partition[sequence, m, 1];
    probabilities = Apply[#2/Length[blocks] &, Tally[blocks], {1}];
    N[Tr[-Log[probabilities]*probabilities]]
)

It will probably run faster if I apply N directly to the result of Tally.

By the way, Mathematica does actually have an Entropy function, that reduces this to 28 bytes, but that's definitely against the rules.

f=N@Entropy@Partition[##,1]&

On the other hand, here is a 128 byte version that reimplements Partition and Tally:

f=N@Tr[-Log[p=#2/n&@@@({#[[i;;i+#2-1]],1}~Table~{i,1,(n=Length@#-#2+1)}//.{p___,{s_,x_},q___,{s_,y_},r___}:>{p,{s,x+y},q,r})]p]&

Ungolfed:

f[sequence_, m_] := (
    n = Length[sequence]-m+1; (*number of blocks*)
    blocks = Table[{Take[sequence, {i, i+m-1}], 1},
                   {i, 1, n}];
    blocks = b //. {p___, {s_, x_}, q___, {s_, y_}, r___} :> {p,{s,x+y},q,r};
    probabilities = Apply[#2/n &, blocks, {1}];
    N[Tr[-Log[probabilities]*probabilities]]
)
| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Partition and Tally are not borderline cases, they are breaking the rules outright, as they are “extracting all blocks of size m from A” and “counting the number of occurrences of a given block x”, respectively, in one call. Still, after all I know about Mathematica, I would not be surprised, if there were a decent solution without them. \$\endgroup\$ – Wrzlprmft Mar 16 '14 at 18:04
  • 1
    \$\begingroup\$ @Wrzlprmft I've added a not-so-golfed version where I reimplement Partition and Tally. \$\endgroup\$ – Martin Ender Mar 16 '14 at 18:27
3
\$\begingroup\$

Perl, 140 bytes

The following Perl script defines a function E that takes the symbol sequence, followed by segment size as arguments.

sub E{$m=pop;$E=0;%h=();$"=',';$_=",@_,";for$i(0..@_-$m){next
if$h{$s=",@_[$i..$i+$m-1],"}++;$E-=($p=s|(?=$s)||g/(@_-$m+1))*log$p;}return$E}

Ungolfed version with test

sub E { # E for "entropy"
    # E takes the sequence and segment size as arguments
    # and returns the calculated entropy.
    $m = pop;    # get segment size (last argument)
    $E = 0;      # initialize entropy
    %h = ();     # hash that remembers already calculated segments
    $" = ',';#"  # comma is used as separator
    $_ = ",@_,"; # $_ takes sequence as string, with comma as delimiters
    for $i (0 .. @_-$m) {
        $s = ",@_[$i..$i+$m-1],"; # segment
        next if$h{$s}++;          # check, if this segment is already calculated
        $p = s|(?=\Q$s\E)||g / (@_ - $m + 1); # calculate probability
             # N(x) is calculated using the substitution operator
             # with a zero-width look-ahead pattern
             # (golfed version without "\Q...\E", see below)
        $E -= $p * log($p); # update entropy
    }
    return $E
}

# Test

my @A = (
    2, 3, 4, 1, 2, 3, 0, 0, 3, 2, 3, 0, 2, 2, 4, 4, 4, 1, 1, 1, 0, 4, 1,
    2, 2, 4, 0, 1, 2, 3, 0, 2, 3, 2, 3, 2, 0, 1, 3, 4, 4, 0, 2, 1, 4, 3,
    0, 2, 4, 1, 0, 4, 0, 0, 2, 2, 0, 2, 3, 0, 0, 4, 4, 2, 3, 1, 3, 1, 1,
    3, 1, 3, 1, 0, 0, 2, 2, 4, 0, 3, 2, 2, 3, 0, 3, 3, 0, 0, 4, 4, 1, 0,
    2, 3, 0, 0, 1, 4, 4, 3
);

print "m = $_: ", E(@A, $_), "\n" for 1 .. @A;

Result:

m = 1: 1.59938036027528
m = 2: 3.06545141203611
m = 3: 4.06663334311518
m = 4: 4.41210802885304
m = 5: 4.53546705894451
m = 6: 4.55387689160055
m = 7: 4.54329478227001
m = 8: 4.53259949315326
m = 9: 4.52178857704904
...
m = 97: 1.38629436111989
m = 98: 1.09861228866811
m = 99: 0.693147180559945
m = 100: 0

Symbols:

The symbols are not restricted to integers, because pattern matching based on strings is used. The string representation of a symbol must not contain the comma, because it is uses as delimiter. Of course, different symbols must have different string representations.

In the golfed version, the string representation of the symbols should not contain specials characters of patterns. The additional four bytes \Q...\E are not needed for numbers.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Can be about 1/4 shorter: sub f{($s,$m,$r,%h)=@_;$h{x,@$s[$_..$_+$m-1]}++for 0..@$s-$m;$r-=($_/=@$s-$m+1)*log for values %h;return$r}; where $s is a reference, $r and %h are reset to undef with 1st assignment, lists are hash keys (with little help of $;, and some x - unfortunately), and a bit less complicated in general, I think. \$\endgroup\$ – user2846289 Mar 16 '14 at 17:29
  • \$\begingroup\$ @VadimR: Clever! Because of the substantial changes I suggest, you make an answer. The space in values %h is not needed, thus your solution only needs 106 bytes. \$\endgroup\$ – Heiko Oberdiek Mar 16 '14 at 18:33
2
\$\begingroup\$

Python 127 152B 138B

import math
def E(A,m):N=len(A)-m+1;R=range(N);return sum(math.log(float(N)/b) for b in [sum(A[i:i+m]==A[j:j+m] for i in R) for j in R])/N

Adjusted to not break the rules any more and have a slightly cuter algorithm. Adjusted to be smaller

Older version:

import math
def E(A,m):
 N=len(A)-m+1
 B=[A[i:i+m] for i in range(N)]
 return sum([math.log(float(N)/B.count(b)) for b in B])/N

My first ever Python script! See it in action: http://pythonfiddle.com/entropy

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Nice so far, but unfortunately, the use of the count function is outright against the rules, since it is “counting the number of occurrences of a given block x”. \$\endgroup\$ – Wrzlprmft Mar 19 '14 at 10:10
  • \$\begingroup\$ Also, some golfing tips: You can save some characters by cramming every line except the first into one (separated by ; if necessary). Also the square brackets in the last line are not needed. \$\endgroup\$ – Wrzlprmft Mar 19 '14 at 10:12
  • \$\begingroup\$ Nice answer. Again, some golfing tips: The whole conversion from boolean to integer (i.e., and 1 or 0) is unnecessary. Also, you can save some characters by predefining range(N). \$\endgroup\$ – Wrzlprmft Mar 23 '14 at 11:06
1
\$\begingroup\$

Python with Numpy, 146 143 Bytes

As promised, here is my own solution. It requires an input of non-negative integers:

from numpy import*
def e(A,m):
    B=zeros(m*[max(A)+1]);j=0
    while~len(A)<-j-m:B[tuple(A[j:j+m])]+=1;j+=1
    return -sum(x*log(x)for x in B[B>0]/j)

The disadvantage is that this bursts your memory for a large m or max(A).

Here is the mostly ungolfed and commented version:

from numpy import *
def e(A,m):
    B = zeros(m*[max(A)+1])          # Generate (max(A)+1)^m-Array of zeroes for counting.
    for j in range(len(A)-m+1):
        B[tuple(A[j:j+m])] += 1      # Do the counting by directly using the array slice
                                     # for indexing.
    C = B[B>0]/(len(A)-m+1)          # Flatten array, take only non-zero entries,
                                     # divide for probability.
    return -sum(x*log(x) for x in C) # Calculate entropy
| improve this answer | |
\$\endgroup\$
1
\$\begingroup\$

MATLAB

function E =BlockEntropy01(Series,Window,Base )

%-----------------------------------------------------------
% Calculates BLOCK ENTROPY of Series
% Series: a Vector of numbers
% Base: 2 or 10 (affects logarithm of the Calculation)
% for 2 we use log2, for 10 log10
% Windows: Length of the "Sliding" BLOCK
% E: Entropy
%-----------------------------------------------------------
% For the ENTROPY Calculations
% http://matlabdatamining.blogspot.gr/2006/....
% 11/introduction-to-entropy.html
% BlogSpot: Will Dwinnell
%-----------------------------------------------------------
% For the BLOCK ENTROPY
% http://codegolf.stackexchange.com/...
% questions/24316/calculate-the-block-entropy
%-----------------------------------------------------------
% Test (Base=10)
% Series=[2, 3, 4, 1, 2, 3, 0, 0, 3, 2, 3, 0, ....
%     2, 2, 4, 4, 4, 1, 1, 1, 0, 4, 1,2, 2, 4, 0, ....
%     1, 2, 3, 0, 2, 3, 2, 3, 2, 0, 1, 3, 4, 4, 0, ....
%     2, 1, 4, 3,0, 2, 4, 1, 0, 4, 0, 0, 2, 2, 0, ....
%     2, 3, 0, 0, 4, 4, 2, 3, 1, 3, 1, 1,3, 1, 3, 1, ....
%     0, 0, 2, 2, 4, 0, 3, 2, 2, 3, 0, 3, 3, 0, 0, 4, ...
%     4, 1, 0,2, 3, 0, 0, 1, 4, 4, 3]';
%
% Results 
%
% Window=1: 1.599
% Window=2: 3.065
% Window=3: 4.067
% Window=4: 4.412
% Window=5: 4.535
% Window=6: 4.554
%-----------------------------------------------------------
n=length(Series);
D=zeros(n,Window); % Pre Allocate Memory
for k=1:Window;    D(:,k)=circshift(Series,1-k);end
D=D(1:end-Window+1,:); % Truncate Last Part
%
% Repace each Row with a "SYMBOL"
% in this Case a Number ...............
[K l]=size(D);
for k=1:K; MyData(k)=polyval(D(k,:),Base);end
clear D
%-----------------------------------------------------------
% ENTROPY CALCULATIONS on MyData
% following  Will Dwinnell
%-----------------------------------------------------------
UniqueMyData = unique(MyData);
nUniqueMyData = length(UniqueMyData);
FreqMyData = zeros(nUniqueMyData,1); % Initialization
for i = 1:nUniqueMyData
    FreqMyData(i) = ....
        sum(double(MyData == UniqueMyData(i)));
end
% Calculate sample class probabilities
P = FreqMyData / sum(FreqMyData);
% Calculate entropy in bits
% Note: floating point underflow is never an issue since we are
%   dealing only with the observed alphabet
if Base==10
    E= -sum(P .* log(P));
elseif BASE==2
    E= -sum(P .* log2(P));
else
end
end

WITH TEST SCRIPT 
%-----------------------------------------------------------
Series=[2, 3, 4, 1, 2, 3, 0, 0, 3, 2, 3, 0, ....
    2, 2, 4, 4, 4, 1, 1, 1, 0, 4, 1,2, 2, 4, 0, ....
    1, 2, 3, 0, 2, 3, 2, 3, 2, 0, 1, 3, 4, 4, 0, ....
    2, 1, 4, 3,0, 2, 4, 1, 0, 4, 0, 0, 2, 2, 0, ....
    2, 3, 0, 0, 4, 4, 2, 3, 1, 3, 1, 1,3, 1, 3, 1, ....
    0, 0, 2, 2, 4, 0, 3, 2, 2, 3, 0, 3, 3, 0, 0, 4, ...
    4, 1, 0,2, 3, 0, 0, 1, 4, 4, 3]';
Base=10;
%-----------------------------------------------------------
for Window=1:6
    E =BlockEntropy01(Series,Window,Base )
end
| improve this answer | |
\$\endgroup\$
  • 3
    \$\begingroup\$ Welcome to PPCG.SE! This is a code golf challenge, where the goal is to solve a problem in as few characters as possible. Please add a version without comments, minimal whitespace and single-character variable names (and any other shortcuts you can think of) as well as the number of bytes in that code. \$\endgroup\$ – Martin Ender Jul 27 '14 at 11:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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