view release on metacpan or  search on metacpan

t/02_general.t  view on Meta::CPAN

# make test
# perl Makefile.PL && make && perl -Iblib/lib t/02_general.t

use lib '.'; BEGIN{require 't/common.pl'}
use Test::More tests => 204;
use Digest::MD5 qw(md5_hex);

my @empty;
#-- min, max
ok(min(1,2,3,undef,4)==1, 'min');
ok(max(undef,1,4,3,4)==4, 'max');
ok(not defined min());
ok(not defined max());
ok(not defined min(@empty));
ok(not defined max(@empty));

#-- mins, maxs
ok(mins('2','4','10') eq '10', 'mins');
ok(maxs(2,4,10) == 4, 'maxs');

#--sum
ok(sum(2)==2);
ok(sum(2,2)==4);
ok(sum(2,-2)==0);
ok(sum(1..1000)==500500);
ok(!defined sum(),              'def sum');
ok(!defined sum(@empty),        'def sum');
ok(!defined(sum(undef,undef)),  'def sum');
ok(sum(undef,2)==2,             'def sum');
ok(sum(3,undef)==3,             'def sum');

#--avg, geomavg
ok(avg(2,4,9)==5,               'avg 2 4 9 is 5');
ok(avg([2,4,9])==5,             'avg 2 4 9 is 5');
ok(avg(2,4,9,undef)==5,         'avg ignore undef');
ok(0==0+grep{abs(geomavg($_,$_)-$_)>1e-8}range(3,10000,13));
ok(abs(geomavg(2,3,4,5)-3.30975091964687)<1e-11);
ok(abs(geomavg(10,100,1000,10000,100000)-1000)<1e-8);
ok(!defined(avg(undef)));

#--stddev
ok(stddev(12,13,14)>0);
ok(between(stddev(map { avg(map rand(),1..100) } 1..100), 0.02, 0.04));
ok(!defined(stddev()));
for((1,10,100)){ my @a=map rand(),1..$_; ok(stddev(@a) == stddev(\@a),'stddev: not ref vs ref') }
#print map"$_\n", sort {$a<=>$b} map stddev(map { avg(map rand(),1..100) } 1..100), 1..1000;

#--median
ok(median(2,3,4,5,6)==4);
ok(median(2,3,4,5)==3.5);
ok(median(2)==2);
ok(median(reverse(1..10000))==5000.5);
ok(median( 1, 4, 6, 7, 8, 9, 22, 24, 39, 49, 555, 992 ) == 15.5 );
ok(not defined median(undef));

#--percentile
ok(percentile(25, 1, 4, 6, 7, 8, 9, 22, 24, 39, 49, 555, 992 ) == 6.25);
ok(percentile(75, 1, 4, 6, 7, 8, 9, 22, 24, 39, 49, 555, 992 ) == 46.5);
ok(join(", ",percentile([0,1,25,50,75,99,100], 1,4,6,7,8,9,22,24,39,49,555,992))
	    eq '-2, -1.61, 6.25, 15.5, 46.5, 1372.19, 1429');


#--nvl
ok(not defined nvl());
ok(not defined nvl(undef));
ok(not defined nvl(undef,undef));
ok(not defined nvl(undef,undef,undef,undef));
ok(nvl(2.0)==2);
ok(nvl("3e0")==3);
ok(nvl(undef,4)==4);
ok(nvl(undef,undef,5)==5);
ok(nvl(undef,undef,undef,6)==6);
ok(nvl(undef,undef,undef,undef,7)==7);

#--replace
ok( replace("water","ater","ine") eq 'wine' );
ok( replace("water","ater")       eq 'w');
ok( replace("water","at","eath")  eq 'weather');
ok( replace("water","wa","ju",
                    "te","ic",
                    "x","y",
                    'r$',"e")     eq 'juice' );
ok( replace('JACK and JUE','J','BL') eq 'BLACK and BLUE' );
ok( replace('JACK and JUE','J')      eq 'ACK and UE' );
ok( replace('a2b3c4',qr/\d/) eq 'abc');
ok( replace('a2b3c4','\d') eq 'abc');
ok( replace('a2b3c4',qr{[^a-z]},'.') eq 'a.b.c.');
ok( replace('a2b3c4','[^a-z]','.') eq 'a.b.c.');
my $str="test";
replace(\$str,'e','ee','s','S');
ok( $str eq 'teeSt' );
ok( replace("abc","a","b","b","c") eq "ccc" ); #not bcc

#--decode, decode_num
my $test=123;
ok( decode($test, 123,3, 214,4, $test)   == 3             ,'decode easy');
ok( decode($test, 122=>3, 214=>7, $test) == 123           ,'decode else');
ok( !defined decode($test, '123.0'=>3, 214=>7)            ,'decode !def'); # prints nothing (undef)
ok( decode($test, 123.0=>3, 214=>7)      == 3             ,'decode float');
ok( decode_num($test, 121=>3, 221=>7, '123.0','b') eq 'b' ,'decode_num');

#--between
ok( between(7, 1,10)           ,'between a');
ok( between(undef, 1,10) eq '' ,'between b');
ok( between(7, 10,1)           ,'between c');
ok( between(5,5,5)             ,'between d');

#--btw, a better(?) between
ok( btw(7, 1,10)           ,'btw a');
ok( btw(undef, 1,10) eq '' ,'btw b');
ok( btw(7, 10,1)           ,'btw c');
ok( btw(5,5,5)             ,'btw d');
ok( btw(1,1,10)            ,'btw e'); # numeric order since all three looks like number according to =~$Re_isnum
ok( btw(1,'02',13)         ,'btw f'); # leading zero in '02' leads to alphabetical order
ok( btw(10, 012,10)        ,'btw h'); # leading zero here means oct number, 012 = 10 (8*1+2), so 10 is btw 10 and 10
ok(!btw('003', '02', '09') ,'btw i'); #
ok(!btw('a', 'b', 'c')     ,'btw j'); #
ok( btw('a', 'B', 'c')     ,'btw k'); #
ok( btw('a', 'c', 'B')     ,'btw l'); #