32_math.pm

   1 # math for DCT, by Shiar
   2
   3 # 1.13.0 20041104     - new addmenu() call
   4 # 1.10.4 200410282330 - trig functions from basic menu
   5 # 1.10.3 200410152245 - rnd, atan, pi
   6 #                     - trigonometry functions seperated
   7 # 1.10.2 200410132050 - probability functions: comb, perm, rdz
   8 # 1.10.1 200410112340 - adds menu items via addmenu() call
   9 # 1.09.2 200410112050 - functions don't handle stack themselves,
  10 #                       but behave like real functions
  11 # 1.09.1 200410022255 - moved from 1.9 main
  12
  13 #todo: check for errors, eg division by zero
  14
  15 use strict;
  16 use warnings;
  17 use utf8;
  18
  19 %action = (
  20         %action,
  21
  22         '+'    => [2, sub { $_[1] + $_[0] }], # addition
  23         '-'    => [2, sub { $_[1] - $_[0] }], # substraction
  24         '*'    => [2, sub { $_[1] * $_[0] }], # multiplication
  25         '/'    => [2, sub { $_[1] / $_[0] }], # division
  26         'mod'  => [2, sub { $_[1] % $_[0] }], # modulo
  27
  28         'inv'  => [1, sub { 1 / $_[0] }], # 1/x
  29         'sqrt' => [1, sub { sqrt $_[0] }], # square root
  30         'sq'   => [1, sub { $_[0] * $_[0] }], # squared
  31         '^'    => [2, sub { $_[1] ** $_[0] }], # exponentiation
  32         'xroot'=> [2, sub { $_[1] ** (1/$_[0]) }], # x-root of y
  33
  34         # logarithmic
  35         'log'  => [1, sub { log($_[0]) / log(10) }], # logarithm
  36         'alog' => [1, sub { 10 ** $_[0] }], # 10^x
  37         'ln'   => [1, sub { log $_[0] }], # natural logaritm
  38         'lnp1' => [1, sub { log($_[0] + 1) }], # ln(x+1)
  39         'exp'  => [1, sub { exp $_[0] }], # e^x
  40         'expm' => [1, sub { exp($_[0]) - 1 }], # exp(x)-1
  41
  42         # binary
  43         'and'  => [2, sub { $_[1] & $_[0] }], # bitwise and
  44         'or'   => [2, sub { $_[1] | $_[0] }], # bitwise or
  45         'xor'  => [2, sub { $_[1] ^ $_[0] }], # bitwise xor
  46         'not'  => [2, sub { ~$_[0] }], # bitwise not
  47         'sl'   => [1, sub { $_[0] * 2 }], # shift left
  48         'sr'   => [1, sub { $_[0] / 2 }], # shift right
  49
  50         # unclassified
  51         '%'    => [2, sub { $_[0] / $_[1] }], # percentage
  52 #       '%ch'  => [2, sub { $val{i} = 100*(shift(@_)-$val{i})/$val{i} }], # percentage change
  53 #       '%t'   => [2, sub { $val{i} = 100*$val{i}/shift(@_) }], # percentage total
  54
  55         'abs'  => [1, sub { abs $_[0] }], # absolute
  56         'sign' => [1, sub { $_[0] <=> 0 }], # sign
  57         'ip'   => [1, sub { int $_[0] }], # integer part
  58         'fp'   => [1, sub { $_[0] - int $_[0] }], # fractional part
  59
  60         'rnd'  => [1, sub { sprintf "%.0f", $_[0] }], # round
  61 #       'trnc' => [1, sub { local $_ = 10**$_[0]; $val{i} = int($val{i}*$_)/$_ }], # truncate
  62         'floor'=> [1, sub { int $_[0] }], # floor
  63         'ceil' => [1, sub { int $_[0]+.9999 }], # ceil
  64
  65         'min'  => [2, sub { $_[1]<$_[0] ? $_[1] : $_[0] }], # minimum
  66         'max'  => [2, sub { $_[1]>$_[0] ? $_[1] : $_[0] }], # maximum
  67
  68         # number base
  69         'dec'  => [-1, sub { $::set{base} = 10; () }], # decimal
  70         'bin'  => [-1, sub { $::set{base} = 2; () }], # binary
  71         'oct'  => [-1, sub { $::set{base} = 8; () }], # octal
  72         'hex'  => [-1, sub { $::set{base} = 16; () }], # hexadecimal
  73         'base' => [1, sub { $::set{base} = $_[0]; () }], # alphanumerical
  74
  75         # probability
  76         'comb' => [2, sub {
  77                 my $res = 1;
  78                 $res *= $_ for $_[1]-$_[0]+1..$_[1];  # (n-r+1)..(n-2)(n-1)n
  79                 $res /= $_ for 2..$_[0];  # / r!
  80                 $res;  # n!/(r!(n-r)!)
  81         }], # combinations
  82         'perm' => [2, sub {
  83                 my $res = 1;
  84                 $res *= $_ for $_[1]-$_[0]+1..$_[1];  # (n-r+1)..(n-2)(n-1)n
  85                 $res;  # n!/(n-r)!
  86         }], # permutations
  87         '!'    => [1, sub { my $res = $_[0]; $res *= $_ for 2..$res-1; $res }], # factor
  88         'rand' => [0, sub { rand }], # random value <1
  89         'rdz'  => [1, sub { srand $_[0]; () }], # seed randomizer
  90 #       'ndist'=> [3], # normal distribution
  91 #       'utpn' => [3], # normal distribution
  92 #       'utpt' => [1], # student-t distribution
  93 #       'utpc' => [2], # chi-square (χ²) distribution
  94 #       'utpf' => [3], # F distribution
  95 ); # newaction
  96
  97 addmenu("main", "math",
  98         [qw(basic sq sqrt ^ xroot log alog ln exp)],
  99 #       [qw(vector)],
 100 #       [qw(matrix)],
 101 #       [qw(list)],
 102 #       [qw(hyperbolic sinh cosh tanh asinh acosh atanh expm lnp1)],
 103         [qw(real % %ch %t min max mod abs sign mant xpon ip fp rnd trnc floor ceil r>d d>r)],
 104         [qw(base dec bin oct hex),
 105                 [qw(logic and or xor not)],
 106                 [qw(bit rl sl asr sr rr)],
 107 #               [qw(byte rlb slb srb rrb)],
 108         ], # base
 109         [qw(probability comb perm ! rand rdz)], # utpc utpf utpn utpt ndist)],
 110 #       [qw(fft)],
 111 #       [qw(complex)],
 112 #       [qw(constants)],
 113 ); # addmenu
 114
 115 return {
 116         author  => "Shiar",
 117         title   => "basic math",
 118         version => "1.13",
 119 };
 120