################################################################################
#
#  kPerl Logics/Mathematics Library Group
#  Library for Random Variables and Randomization
#
#  copyright (c)
#    Karol Szafranski, 2005
#    Institute of Molecular Biotechnology Jena, Dept. Genome Analysis, 2000
#  author
#    Karol Szafranski, karol.szafranski@leibniz-fli.de
#
################################################################################
#
#  DESCRIPTION
#
# - individual description of functions at the beginning of the code blocks
#
################################################################################
#
#  FUNCTIONS, DATA
#
#   @EXPORT
#   %_LibParam
#
# - basics
#   $_LibParam{*}
#   &_RandInit
#
# - generate random values
#   &RandInt
#   &RandStr
#
# - randomization
#   &ClassvalRandomize
# ( &RandArrayEntryWgt
#   &RandArrayOrder
#
#
#  STD OPTIONS
#
#   -debug      print debug protocol to STDERR
#
################################################################################

package Math::kRandom;

# includes
use strict; #use warnings;  # OK 20050618

# symbol export
use Exporter qw(import);
our @EXPORT = qw (
  &RandInt &RandStr
  &ClassvalRandomize &RandArrayOrder
  );

# package-wide constants and variables
my %_LibParam;


################################################################################
# basics
################################################################################


$_LibParam{initialized} = 0;
&_RandInit();


# ensure initialization of random value generator
#
sub _RandInit {
  unless ($_LibParam{initialized}) {
    srand (11 * int ((time() ^ ($$ + ($$ << 15))) / 11));
    $_LibParam{initialized} = 1;
  }
}


################################################################################
# generate random values
################################################################################


# random integer
#
# INTERFACE
# - argument 1: maximum value
# - options:
#   -min        minimum value, default: 0
# - return val: random integer value
#
sub RandInt {
  my ($max,%opt) = @_;
  my $min = int ($opt{-min}||0);
  my $ValRand = $min + int (rand ($max-$min+1));
  return $ValRand;
}


# random string
#
# INTERFACE
# - argument 1: length of string to be generated
#
# - options:
#   -chars      supply a string containing characters to be used to generate
#               the random string, default: all letters (both lower and upper
#               case) and digits
#
# - return val: generated string
#
sub RandStr {
  my ($StrLen,%opt) = @_;

  # function parameters
  my $chars = $opt{-chars} || join('','a'..'z','A'..'Z',0..9);
  my $CharNum = length ($chars);

  # loop over positions
  my $str='';
  for (my $CtI=0; $CtI<$StrLen; ++$CtI) {
    $str .= substr ($chars, int rand($CharNum), 1);
  }

  return $str;
}


################################################################################
# randomization
################################################################################


# randomize class value to any value in the class interval
#
# INTERFACE
# - argument 1: class value
#
# - options:
#   -debug      [STD]
#   -lower      specifiy lowest class value, default: 0
#   -step       specifiy class step size, default: 1
#   -upper      specifiy upper class value, default: none
#
# - return val: randomized class value
#
sub ClassvalRandomize {
  my ($ValArg, %opt) = @_;
  my $debug = $opt{-debug};
  my $ValLower = exists($opt{-lower}) ? $opt{-lower} : 0;
  my $ValStep  = defined($opt{-step}) ? $opt{-step} : 1;
  $ValStep *= 1.0001;
  my $ValUpper = exists($opt{-upper}) ? $opt{-upper} : undef;

  # value bumps on one of class extremes?
  my $ValOff = -0.5 * $ValStep;
  if (defined($ValLower) and $ValArg<=$ValLower) {
    $ValArg = $ValLower;
    $ValOff = -0.0001 * $ValStep;
    $ValStep *= 0.5;
  }
  if (defined($ValUpper) and $ValArg>=$ValUpper) {
    $ValArg = $ValUpper;
    $ValStep *= 0.5;
  }

  # random recalculation
  my $ValRand = rand ($ValStep);
  my $ValRet = $ValArg + $ValOff + $ValRand;

  # debug
  if ($debug) {
    printf STDERR "%s. debug:\n", (caller(0))[3];
    printf STDERR "  value argument: %s\n", $ValArg;
    printf STDERR "  lower value boundary: %s\n", $ValLower;
    printf STDERR "  upper value boundary: %s\n", $ValUpper;
    printf STDERR "  randomizing offset: %s\n", $ValOff;
    printf STDERR "  class size: %s\n", $ValStep;
    printf STDERR "  random value: %s\n", $ValRand;
    printf STDERR "  return value: %s\n", $ValRet;
  }

  # randomize value
  return $ValRet;
}


# randomly select entry from weighted array
#
# INTERFACE
# - argument 1: array of weights
# - return val: randomly picked entry (index value)
#
# sub RandArrayEntryWgt {
# ...
# }
# can be found in code package ngsmap, script peuniq_series_simul.pl 


# change order of array entries random
#
# INTERFACE
# - argument 1: reference to array
#               referenced data is left unchanged
# - options:
#   -debug      [STD]
# - return val: - reference to randomized array
#               - \() if an error occurred
#
# DESCRIPTION
# - each single array entry from input will be found singly again in the output
#   array.
#
sub RandArrayOrder {
  my ($pArray) = @_;
  unless (ref($pArray) eq 'ARRAY') { return undef }
  my @source = @$pArray;

  # repeated random selection
  my @target;
  for (my $srcsz=int(@source); $srcsz>=0; --$srcsz) {
    my $entry = int rand($srcsz);
    push @target, splice(@source,$entry,1);
  }

  return \@target;
}


1;
# $Id: kRandom.pm,v 1.16 2018/06/05 18:02:56 szafrans Exp $
