aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

update

Browse source
This commit is contained in:
Ingy döt Net 2013-06-05 21:47:54 +00:00
parent 1f1ad49427
commit 6f050a029e
2496 changed files with 37609 additions and 3031 deletions
Download patch file Download diff file Expand all files Collapse all files

46
Task/Entropy/C/entropy-1.c Normal file
View file

@ -0,0 +1,46 @@
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <string.h>
#include <math.h>
#define MAXLEN 100 //maximum string length
int makehist(char *S,int *hist,int len){
int wherechar[256];
int i,histlen;
histlen=0;
for(i=0;i<256;i++)wherechar[i]=-1;
for(i=0;i<len;i++){
if(wherechar[(int)S[i]]==-1){
wherechar[(int)S[i]]=histlen;
histlen++;
}
hist[wherechar[(int)S[i]]]++;
}
return histlen;
}
double entropy(int *hist,int histlen,int len){
int i;
double H;
H=0;
for(i=0;i<histlen;i++){
H-=(double)hist[i]/len*log2((double)hist[i]/len);
}
return H;
}
int main(void){
char S[MAXLEN];
int len,*hist,histlen;
double H;
scanf("%[^\n]",S);
len=strlen(S);
hist=(int*)calloc(len,sizeof(int));
histlen=makehist(S,hist,len);
//hist now has no order (known to the program) but that doesn't matter
H=entropy(hist,histlen,len);
printf("%lf\n",H);
return 0;
}

6
Task/Entropy/C/entropy-2.c Normal file
View file

@ -0,0 +1,6 @@
$ ./entropy
1223334444
1.846439
$ ./entropy
Rosetta Code is the best site in the world!
3.646513

6
Task/Entropy/Common-Lisp/entropy.lisp Normal file
View file

@ -0,0 +1,6 @@
(defun entropy(input-string)
(let ((frequency-table (make-hash-table :test 'equal))
(entropy 0))
(map 'nil #'(lambda(c) (setf (gethash c frequency-table) (if (gethash c frequency-table) (+ (gethash c frequency-table) 1) 1))) (coerce input-string 'list))
(maphash #'(lambda(k v) (setf entropy (+ entropy (* -1 (/ v (length input-string)) (log (/ v (length input-string)) 2))))) frequency-table)
entropy))

21
Task/Entropy/Forth/entropy.fth Normal file
View file

@ -0,0 +1,21 @@
: flog2 ( f -- f ) fln 2e fln f/ ;
create freq 256 cells allot
: entropy ( str len -- f )
freq 256 cells erase
tuck
bounds do
i c@ cells freq +
1 swap +!
loop
0e
256 0 do
i cells freq + @ ?dup if
s>f dup s>f f/
fdup flog2 f* f-
then
loop
drop ;
s" 1223334444" entropy f. \ 1.84643934467102 ok

58
Task/Entropy/Fortran/entropy.f Normal file
View file

@ -0,0 +1,58 @@
!-*- mode: compilation; default-directory: "/tmp/" -*-
!Compilation started at Tue May 21 21:43:12
!
!a=./f && make $a && OMP_NUM_THREADS=2 $a 1223334444
!gfortran -std=f2008 -Wall -ffree-form -fall-intrinsics f.f08 -o f
! Shannon entropy of 1223334444 is 1.84643936
!
!Compilation finished at Tue May 21 21:43:12
program shannonEntropy
implicit none
integer :: num, L, status
character(len=2048) :: s
num = 1
call get_command_argument(num, s, L, status)
if ((0 /= status) .or. (L .eq. 0)) then
write(0,*)'Expected a command line argument with some length.'
else
write(6,*)'Shannon entropy of '//(s(1:L))//' is ', se(s(1:L))
endif
contains
! algebra
!
! 2**x = y
! x*log(2) = log(y)
! x = log(y)/log(2)
! NB. The j solution
! entropy=: +/@:-@(* 2&^.)@(#/.~ % #)
! entropy '1223334444'
!1.84644
real function se(s)
implicit none
character(len=*), intent(in) :: s
integer, dimension(256) :: tallies
real, dimension(256) :: norm
tallies = 0
call TallyKey(s, tallies)
! J's #/. works with the set of items in the input.
! TallyKey is sufficiently close that, with the merge, gets the correct result.
norm = tallies / real(len(s))
se = sum(-(norm*log(merge(1.0, norm, norm .eq. 0))/log(2.0)))
end function se
subroutine TallyKey(s, counts)
character(len=*), intent(in) :: s
integer, dimension(256), intent(out) :: counts
integer :: i, j
counts = 0
do i=1,len(s)
j = iachar(s(i:i))
counts(j) = counts(j) + 1
end do
end subroutine TallyKey
end program shannonEntropy

51
Task/Entropy/Java/entropy.java Normal file
View file

@ -0,0 +1,51 @@
import java.lang.Math;
import java.util.Map;
import java.util.HashMap;
public class REntropy {
@SuppressWarnings("boxing")
public static double getShannonEntropy(String s) {
int n = 0;
Map<Character, Integer> occ = new HashMap<>();
for (int c_ = 0; c_ < s.length(); ++c_) {
char cx = s.charAt(c_);
if (occ.containsKey(cx)) {
occ.put(cx, occ.get(cx) + 1);
} else {
occ.put(cx, 1);
}
++n;
}
double e = 0.0;
for (Map.Entry<Character, Integer> entry : occ.entrySet()) {
char cx = entry.getKey();
double p = (double) entry.getValue() / n;
e += p * log2(p);
}
return -e;
}
private static double log2(double a) {
return Math.log(a) / Math.log(2);
}
public static void main(String[] args) {
String[] sstr = {
"1223334444",
"1223334444555555555",
"122333",
"1227774444",
"aaBBcccDDDD",
"1234567890abcdefghijklmnopqrstuvwxyz",
"Rosetta Code",
};
for (String ss : sstr) {
double entropy = REntropy.getShannonEntropy(ss);
System.out.printf("Shannon entropy of %40s: %.12f%n", "\"" + ss + "\"", entropy);
}
return;
}
}

73
Task/Entropy/NetRexx/entropy.netrexx Normal file
View file

@ -0,0 +1,73 @@
/* NetRexx */
options replace format comments java crossref savelog symbols
runSample(Arg)
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
/* REXX ***************************************************************
* 28.02.2013 Walter Pachl
**********************************************************************/
method getShannonEntropy(s = "1223334444") public static
--trace var occ c chars n cn i e p pl
Numeric Digits 30
occ = 0
chars = ''
n = 0
cn = 0
Loop i = 1 To s.length()
c = s.substr(i, 1)
If chars.pos(c) = 0 Then Do
cn = cn + 1
chars = chars || c
End
occ[c] = occ[c] + 1
n = n + 1
End i
p = ''
Loop ci = 1 To cn
c = chars.substr(ci, 1)
p[c] = occ[c] / n
End ci
e = 0
Loop ci = 1 To cn
c = chars.substr(ci, 1)
pl = log2(p[c])
e = e + p[c] * pl
End ci
Return -e
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method log2(a = double) public static binary returns double
return Math.log(a) / Math.log(2)
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(Arg) public static
parse Arg sstr
if sstr = '' then
sstr = '1223334444' -
'1223334444555555555' -
'122333' -
'1227774444' -
'aaBBcccDDDD' -
'1234567890abcdefghijklmnopqrstuvwxyz' -
'Rosetta_Code'
say 'Calculating Shannon''s entropy for the following list:'
say '['(sstr.space(1, ',')).changestr(',', ', ')']'
say
entropies = 0
ssMax = 0
-- This crude sample substitutes a '_' character for a space in the input strings
loop w_ = 1 to sstr.words()
ss = sstr.word(w_)
ssMax = ssMax.max(ss.length())
ss_ = ss.changestr('_', ' ')
entropy = getShannonEntropy(ss_)
entropies[ss] = entropy
end w_
loop report = 1 to sstr.words()
ss = sstr.word(report)
ss_ = ss.changestr('_', ' ')
Say 'Shannon entropy of' ('"'ss_'"').right(ssMax + 2)':' entropies[ss].format(null, 12)
end report
return

1
Task/Entropy/PARI-GP/entropy.pari Normal file
View file

@ -0,0 +1 @@
entropy(s)=s=Vec(s);my(v=vecsort(s,,8));-sum(i=1,#v,(x->x*log(x))(sum(j=1,#s,v[i]==s[j])/#s))/log(2)

32
Task/Entropy/REXX/entropy-1.rexx
View file

@ -1,24 +1,38 @@
/* Rexx ***************************************************************
/* REXX ***************************************************************
* 28.02.2013 Walter Pachl
* 12.03.2013 Walter Pachl typo in log corrected. thanx for testing
* 22.05.2013 -"- extended the logic to accept other strings
* 25.05.2013 -"- 'my' log routine is apparently incorrect
* 25.05.2013 -"- problem identified & corrected
**********************************************************************/
s="1223334444"
Numeric Digits 30
Parse Arg s
If s='' Then
s="1223334444"
occ.=0
chars=''
n=0
cn=0
Do i=1 To length(s)
c=substr(s,i,1)
If pos(c,chars)=0 Then Do
cn=cn+1
chars=chars||c
End
occ.c=occ.c+1
n=n+1
End
do c=1 To 4
do ci=1 To cn
c=substr(chars,ci,1)
p.c=occ.c/n
say c p.c
/* say c p.c */
End
e=0
Do c=1 To 4
e=e+p.c*log(p.c,,2)
Do ci=1 To cn
c=substr(chars,ci,1)
e=e+p.c*log(p.c,30,2)
End
Say 'Entropy of' s 'is' (-e)
Say 'Version 1:' s 'Entropy' format(-e,,12)
Exit
log: Procedure
@ -28,6 +42,8 @@ log: Procedure
* 0.5 to 1.5
* 1.5 to infinity
* 03.09.1992 Walter Pachl
* 25.05.2013 -"- 'my' log routine is apparently incorrect
* 25.05.2013 -"- problem identified & corrected
***********************************************************************/
Parse Arg x,prec,b
If prec='' Then prec=9
@ -78,7 +94,7 @@ log: Procedure
End
End
If b<>'' Then
r=r/log(b)
r=r/log(b,prec)
Numeric Digits (prec)
r=r+0
Return r

53
Task/Entropy/REXX/entropy-2.rexx
View file

@ -1,30 +1,23 @@
/*REXX program calculates the information entropy for a given char str.*/
numeric digits 30 /*use thirty digits for precision*/
parse arg $; if $=='' then $=1223334444 /*obtain optional input*/
n=0; @.=0; L=length($); $$=
do j=1 for L; _=substr($,j,1) /*process each character in $ str*/
if @._==0 then do; n=n+1 /*if unique, bump char counter. */
$$=$$ || _ /*add this character to the list.*/
end
@._ = @._+1 /*keep track of this char count. */
end /*j*/
sum=0 /*calc info entropy for each char*/
do i=1 for n; _=substr($$,i,1) /*obtain a char from unique list.*/
sum=sum - @._/L * log2(@._/L) /*add (negatively) the entropies.*/
end /*i*/
say ' input string: ' $
say 'string length: ' L
say ' unique chars: ' n ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────LOG2 subroutine─────────────────────*/
log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
do while ig & xx>1.5 | \ig&xx<.5; _=e; do k=-1; iz=xx* _**-is
if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end
xx=izz; ii=ii+is*2**k; end; x=x* e**-ii-1; z=0; _=-1; p=z
do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/
r=z+ii; if arg()==2 then return r; return r/log2(2,0)
/* REXX ***************************************************************
* Test program to compare Versions 1 and 2
* (the latter tweaked to be acceptable by my (oo)Rexx
* and to give the same output.)
* version 1 was extended to accept the strings of the incorrect flag
* 22.05.2013 Walter Pachl (I won't analyze the minor differences)
* 25.05.2013 I did now analyze and had to discover that
* 'my' log routine is apparently incorrect
* Correction is yet to come
*********************************************************************/
Call both '1223334444'
Call both '1223334444555555555'
Call both '122333'
Call both '1227774444'
Call both 'aaBBcccDDDD'
Call both '1234567890abcdefghijklmnopqrstuvwxyz'
Exit
both:
Parse Arg s
Call entropy s
Call entropy2 s
Say ' '
Return

30
Task/Entropy/REXX/entropy-3.rexx Normal file
View file

@ -0,0 +1,30 @@
/*REXX program calculates the information entropy for a given char str.*/
numeric digits 30 /*use thirty digits for precision*/
parse arg $; if $=='' then $=1223334444 /*obtain optional input*/
n=0; @.=0; L=length($); $$=
do j=1 for L; _=substr($,j,1) /*process each character in $ str*/
if @._==0 then do; n=n+1 /*if unique, bump char counter. */
$$=$$ || _ /*add this character to the list.*/
end
@._ = @._+1 /*keep track of this char count. */
end /*j*/
sum=0 /*calc info entropy for each char*/
do i=1 for n; _=substr($$,i,1) /*obtain a char from unique list.*/
sum=sum - @._/L * log2(@._/L) /*add (negatively) the entropies.*/
end /*i*/
say ' input string: ' $
say 'string length: ' L
say ' unique chars: ' n ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────LOG2 subroutine───────────────────────────*/
log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0
numeric digits digits()+5 /* [↓] precision of E must be > digits().*/
e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535
do while ig & xx>1.5 | \ig&xx<.5; _=e; do j=-1; iz=xx* _**-is
if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave; _=_*_; izz=iz; end /*j*/
xx=izz; ii=ii+is*2**j; end /*while*/; x=x* e**-ii-1; z=0; _=-1; p=z
do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/
r=z+ii; if arg()==2 then return r; return r/log2(2,0)