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

Family Day update

Browse source
This commit is contained in:
Ingy döt Net 2020-02-17 23:21:07 -08:00
parent aac6731f2c
commit 9ad63ea473
2442 changed files with 39761 additions and 8255 deletions
Download patch file Download diff file Expand all files Collapse all files

27
Task/Entropy/PHP/entropy.php Normal file
View file

@ -0,0 +1,27 @@
<?php
function shannonEntropy($string) {
$h = 0.0;
$len = strlen($string);
foreach (count_chars($string, 1) as $count) {
$h -= (double) ($count / $len) * log((double) ($count / $len), 2);
}
return $h;
}
$strings = array(
'1223334444',
'1225554444',
'aaBBcccDDDD',
'122333444455555',
'Rosetta Code',
'1234567890abcdefghijklmnopqrstuvwxyz',
);
foreach ($strings AS $string) {
printf(
'%36s : %s' . PHP_EOL,
$string,
number_format(shannonEntropy($string), 6)
);
}

40
Task/Entropy/REXX/entropy-3.rexx
View file

@ -1,30 +1,30 @@
/*REXX program calculates the information entropy for a given character string. */
numeric digits 50 /*use 50 decimal digits for precision. */
parse arg $; if $='' then $=1223334444 /*obtain the optional input from the CL*/
#=0; @.=0; L=length($) /*define handy-dandy REXX variables. */
numeric digits length( e() ) % 2 - length(.) /*use 1/2 of the decimal digits of E. */
parse arg $; if $='' then $= 1223334444 /*obtain the optional input from the CL*/
#=0 ; @.= 0; L= length($) /*define handy-dandy REXX variables. */
$$= /*initialize the $$ list. */
do j=1 for L; _=substr($, j, 1) /*process each character in $ string.*/
if @._==0 then do; #=# + 1 /*Unique? Yes, bump character counter.*/
$$=$$ || _ /*add this character to the $$ list. */
do j=1 for L; _= substr($, j, 1) /*process each character in $ string.*/
if @._==0 then do; #= # + 1 /*Unique? Yes, bump character counter.*/
$$= $$ || _ /*add this character to the $$ list. */
end
@._=@._ + 1 /*keep track of this character's count.*/
@._= @._ + 1 /*keep track of this character's count.*/
end /*j*/
sum=0 /*calculate info entropy for each char.*/
do i=1 for #; _=substr($$, i, 1) /*obtain a character from unique list. */
sum=sum - @._/L * log2(@._/L) /*add (negatively) the char entropies. */
sum= 0 /*calculate info entropy for each char.*/
do i=1 for #; _= substr($$, i, 1) /*obtain a character from unique list. */
sum= sum - @._/L * log2(@._/L) /*add (negatively) the char entropies. */
end /*i*/
say ' input string: ' $
say 'string length: ' L
say ' unique chars: ' # ; say
say ' unique chars: ' # ; say
say 'the information entropy of the string ──► ' format(sum,,12) " bits."
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
log2: procedure; parse arg x 1 ox; ig= x>1.5; ii=0; is=1 - 2 * (ig\==1)
numeric digits digits()+5 /* [↓] precision of E must be≥digits()*/
e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759
do while ig & ox>1.5 | \ig&ox<.5; _=e; do j=-1; iz=ox * _ ** -is
if j>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end /*j*/
ox=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,.)
e: e= 2.718281828459045235360287471352662497757247093699959574966967627724076630; return e
/*──────────────────────────────────────────────────────────────────────────────────────*/
log2: procedure; parse arg x 1 ox; ig= x>1.5; ii= 0; is= 1 - 2 * (ig\==1)
numeric digits digits()+5; call e /*the precision of E must be≥digits(). */
do while ig & ox>1.5 | \ig&ox<.5; _= e; do j=-1; iz= ox * _ ** -is
if j>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _= _ * _; izz= iz; end /*j*/
ox=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,.)