Acme-Tools

 view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

  repl
  replace
  decode
  decode_num
  between
  btw
  curb
  bound
  log10
  log2
  logn
  distinct
  in
  in_num
  uniq
  union
  union_all
  minus
  minus_all
  intersect
  intersect_all
  not_intersect
  mix
  zip
  sim
  sim_perm
  subarr
  subhash
  hashtrans
  zipb64
  zipbin
  unzipb64
  unzipbin
  gzip
  gunzip
  bzip2
  bunzip2
  ipaddr
  ipnum
  ipnum_ok
  iprange_ok
  in_iprange
  webparams
  urlenc
  urldec
  ht2t
  chall
  makedir
  qrlist
  ansicolor
  ccn_ok
  KID_ok
  writefile
  readfile
  readdirectory
  basename
  dirname
  wipe
  username
  range
  globr
  permutations
  perm
  permute
  permute_continue
  trigram
  sliding
  chunks
  chars
  cart
  reduce
  int2roman
  roman2int
  num2code
  code2num
  dec2bin
  dec2hex
  dec2oct
  bin2dec
  bin2hex
  bin2oct
  hex2dec
  hex2bin
  hex2oct
  oct2dec
  oct2bin
  oct2hex
  base
  gcd
  lcm
  pivot
  tablestring
  upper
  lower
  trim
  rpad
  lpad
  cpad
  dserialize
  serialize
  srlz
  cnttbl
  nicenum
  bytes_readable
  sec_readable
  distance
  tms
  s2t
  easter
  time_fp
  timems
  sleep_fp
  sleeps
  sleepms
  sleepus
  sleepns
  eta
  sys
  recursed
  md5sum
  pwgen

Tools.pm  view on Meta::CPAN


First: x (first returned element)

Second: y (up to y but not including y)

Third: step, default 1. The step between each returned element

If a fourth, fifth and so on arguments are given, they change the step for each returned element. As first derivative, second derivative.

B<Output:>

If one argument: returns the array C<(0 .. x-1)>

If two arguments: returns the array C<(x .. y-1)>

If three arguments: The default step is 1. Use a third argument to use a different step.

B<Examples:>

 print join ",", range(11);         # prints 0,1,2,3,4,5,6,7,8,9,10  (but not 11)
 print join ",", range(2,11);       # 2,3,4,5,6,7,8,9,10             (but not 11)
 print join ",", range(11,2,-1);    # 11,10,9,8,7,6,5,4,3
 print join ",", range(2,11,3);     # 2,5,8
 print join ",", range(11,2,-3);    # 11,8,5
 print join ",", range(11,2,+3);    # prints nothing

 print join ", ",range(2,11,1,0.1);       # 2, 3, 4.1, 5.3, 6.6, 8, 9.5   adds 0.1 to step each time
 print join ", ",range(2,11,1,0.1,-0.01); # 2, 3, 4.1, 5.29, 6.56, 7.9, 9.3, 10.75

Note: In the Python language and others, C<range> is a build in iterator (a
generator), not an array. This saves memory for large sets and sometimes time.
Use C<range> in L<List::Gen> to get a similar lazy generator in Perl.

=cut

sub range {
  return _range_accellerated(@_) if @_>3;  #see below
  my($x,$y,$jump)=@_;
  return (  0 .. $x-1 ) if @_==1;
  return ( $x .. $y-1 ) if @_==2;
  croak "Wrong number of arguments or jump==0" if @_!=3 or $jump==0;
  my @r;
  if($jump>0){  while($x<$y){ push @r, $x; $x+=$jump } }
  else       {  while($x>$y){ push @r, $x; $x+=$jump } }
  return @r;
}

#jumps derivative, double der., trippled der usw
sub _range_accellerated {
  my($x,$y,@jump)=@_;
  my @r;
  my $test = $jump[0]>=0 ? sub{$x<$y} : sub{$x>$y};
  while(&$test()){
    push @r, $x;
    $x+=$jump[0];
    $jump[$_-1]+=$jump[$_] for 1..$#jump;
  }
  return @r;
}

=head2 globr

Works like and uses Perls builtin C<< glob() >> but adds support for ranges
with C<< {from..to} >> and C<< {from..to..step} >>. Like brace expansion in bash.

Examples:

 my @arr = glob  "X{a,b,c,d}Z";         # @arr now have four elements: XaZ XbZ XcZ XdZ
 my @arr = globr "X{a,b,c,d}Z";         # same as above
 my @arr = globr "X{a..d}Z";            # same as above
 my @arr = globr "X{a..f..2}";          # step 2, returns array: Xa Xc Xe
 my @arr = globr "{aa..bz..13}Z";       # aaZ anZ baZ bnZ
 my @arr = globr "{1..12}b";            # 1b 2b 3b 4b 5b 6b 7b 8b 9b 10b 11b 12b
 my @arr = globr "{01..11}b";           # 01b 02b 03b 04b 05b 06b 07b 08b 09b 10b 11b (keep leading zero)
 my @arr = globr "{01..12..3}b";        # 01b 04b 07b 10b

=cut

sub globr($) {
  my $p=shift;
  $p=~s{
    \{(-?\w+)\.\.(-?\w+)(\.\.(-?\d+))?\}
  }{
    my $i=0;
    my @r=$1 le $2 ? ($1..$2) : reverse($2..$1);
    @r=grep !($i++%$4),@r if $4;
    "{" . join(",",@r) . "}"
  }xeg;
  glob $p;
}

=head2 permutations

How many ways (permutations) can six people be placed around a table:

 One person:          one way
 Two persons:         two ways  (they can swap places)
 Three persons:         6
 Four persons:         24
 Five persons:        120
 Six  persons:        720

The formula is C<x!> where the postfix unary operator C<!>, also known as I<faculty> is defined as:
C<x! = x * (x-1) * (x-2) ... * 1>. Example: C<5! = 5 * 4 * 3 * 2 * 1 = 120>.Run this to see the 100 first C<< n! >>

 perl -MAcme::Tools -le'$i=big(1);print "$_!=",$i*=$_ for 1..100'

  1!  = 1
  2!  = 2
  3!  = 6
  4!  = 24
  5!  = 120
  6!  = 720
  7!  = 5040
  8!  = 40320
  9!  = 362880
 10!  = 3628800
 .
 .
 .
 100! = 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000

C<permutations()> takes a list and return a list of arrayrefs for each
of the permutations of the input list:

 permutations('a','b');     #returns (['a','b'],['b','a'])

 permutations('a','b','c'); #returns (['a','b','c'],['a','c','b'],
                            #         ['b','a','c'],['b','c','a'],
                            #         ['c','a','b'],['c','b','a'])

Up to five input arguments C<permutations()> is probably as fast as it
can be in this pure perl implementation (see source). For more than
five, it could be faster. How fast is it now: Running with different
n, this many time took that many seconds:

 n   times    seconds
 -- ------- ---------
  2  100000      0.32
  3  10000       0.09
  4  10000       0.33
  5  1000        0.18
  6  100         0.27
  7  10          0.21
  8  1           0.17
  9  1           1.63
 10  1          17.00

If the first argument is a coderef, that sub will be called for each permutation and the return from those calls with be the real return from C<permutations()>. For example this:

Tools.pm  view on Meta::CPAN


# sub mycrc32 {  #http://billauer.co.il/blog/2011/05/perl-crc32-crc-xs-module/  eller String::CRC32::crc32 som er 100 x raskere enn Digest::CRC::crc32
#  my ($input, $init_value, $polynomial) = @_;
#  $init_value = 0 unless (defined $init_value);
#  $polynomial = 0xedb88320 unless (defined $polynomial);
#  my @lookup_table;
#  for (my $i=0; $i<256; $i++) {
#    my $x = $i;
#    for (my $j=0; $j<8; $j++) {
#      if ($x & 1) {
#        $x = ($x >> 1) ^ $polynomial;
#      } else {
#        $x = $x >> 1;
#      }
#    }
#    push @lookup_table, $x;
#  }
#  my $crc = $init_value ^ 0xffffffff;
#  foreach my $x (unpack ('C*', $input)) {
#    $crc = (($crc >> 8) & 0xffffff) ^ $lookup_table[ ($crc ^ $x) & 0xff ];
#  }
#  $crc = $crc ^ 0xffffffff;
#  return $crc;
# }
#
# $maybe_valid_utf8 =~                   # https://stackoverflow.com/questions/11709410/regex-to-detect-invalid-utf-8-string
# m/\A(
#     [\x09\x0A\x0D\x20-\x7E]            # ASCII, or rather: [\x00-\x7F]
#   | [\xC2-\xDF][\x80-\xBF]             # non-overlong 2-byte
#   |  \xE0[\xA0-\xBF][\x80-\xBF]        # excluding overlongs
#   | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}  # straight 3-byte
#   |  \xED[\x80-\x9F][\x80-\xBF]        # excluding surrogates
#   |  \xF0[\x90-\xBF][\x80-\xBF]{2}     # planes 1-3
#   | [\xF1-\xF3][\x80-\xBF]{3}          # planes 4-15
#   |  \xF4[\x80-\x8F][\x80-\xBF]{2}     # plane 16
#  )*\z/x;

=head1 HISTORY

Release history

 0.27  Feb 2020   Small fixes for some platforms

 0.26  Jan 2020   Convert subs: base bin2dec bin2hex bin2oct dec2bin dec2hex dec2oct
                  hex2bin hex2dec hex2oct oct2bin oct2dec oct2hex
                  Array subs: joinr perm permute permute_continue pile sortby subarrays
                  Other subs: btw in_iprange ipnum_ok iprange_ok opts s2t

 0.24  Feb 2019   fixed failes on perl 5.16 and older

 0.23  Jan 2019   Subs: logn, egrep, which. More UTF-8 "oriented" (lower, upper, ...)
                  Commands: zsize, finddup, due (improved), conv (improved, [MGT]?Wh
                  and many more units), due -M for stdin of filenames.

 0.22  Feb 2018   Subs: subarr, sim, sim_perm, aoh2sql. command: resubst

 0.21  Mar 2017   Improved nicenum() and its tests

 0.20  Mar 2017   Subs: a2h cnttbl h2a log10 log2 nicenum rstddev sec_readable
                  throttle timems refa refaa refah refh refha refhh refs
                  eachr globr keysr popr pushr shiftr splicer unshiftr valuesr
                  Commands: 2bz2 2gz 2xz z2z

 0.172 Dec 2015   Subs: curb openstr pwgen sleepms sleepnm srlz tms username
                   self_update install_acme_command_tools
                  Commands: conv due freq wipe xcat (see "Commands")

 0.16  Feb 2015   bigr curb cpad isnum parta parth read_conf resolve_equation
                  roman2int trim. Improved: conv (numbers currency) range ("derivatives")

 0.15  Nov 2014   Improved doc
 0.14  Nov 2014   New subs, improved tests and doc
 0.13  Oct 2010   Non-linux test issue, resolve. improved: bloom filter, tests, doc
 0.12  Oct 2010   Improved tests, doc, bloom filter, random_gauss, bytes_readable
 0.11  Dec 2008   Improved doc
 0.10  Dec 2008

=head1 SEE ALSO

L<https://github.com/kjetillll/Acme-Tools>

=head1 AUTHOR

Kjetil Skotheim, E<lt>kjetil.skotheim@gmail.comE<gt>

=head1 COPYRIGHT

2008-2020, Kjetil Skotheim

=head1 LICENSE

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut



( run in 0.410 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )