view release on metacpan or  search on metacpan

lib/Math/Algebra/Symbols/Term.pm  view on Meta::CPAN

=head3 removeSqrt

Remove square root.

=cut


sub removeSqrt($)
 {my ($t) = @_;
  my $z = $t->clone;
  delete $z->{sqrt};
  $z->z;
 }


=head3 Exp

Get/Set exp

=cut


sub Exp($;$)
 {my ($t, $e) = @_;
  return $t->{exp} unless @_ > 1;
  $t->{exp} = $e;
  $t;
 }


=head3 Log

# Get/Set log

=cut


sub Log($$)
 {my ($t, $l) = @_;
  return $t->{log} unless @_ > 1;
  $t->{log} = $l;
  $t;
 }


=head3 vp

Get/Set variable power.

On get: returns the power of a variable, or zero if the variable is not
present in the term.

On set: Sets the power of a variable. If the power is zero, removes the
variable from the term. =cut

=cut


sub vp($$;$)
 {my ($t, $v) = @_;
# $v =~ /^[a-z]+$/i or die "Bad variable name $v";

  return exists($t->{v}{$v}) ? $t->{v}{$v} : 0 if @_ == 2;

  my $p = ($_[2] == 1 ? $_[2] : intCheck($_[2], 'vp'));
  $t->{v}{$v} = $p   if $p;
  delete $t->{v}{$v} unless $p;
  $t;
 }


=head3 v

Get all variables mentioned in the term.  Variables to power zero
should have been removed by L</vp>.

=cut


sub v($)
 {my ($t) = @_;
  return keys %{$t->{v}};
 }


=head3 clone

Clone a term. The existing term must be finalized, see L</z>: the new
term will not be finalized, allowing modifications to be made to it.

=cut


sub clone($)
 {my ($t) = @_;
  $t->{z} or die "Attempt to clone unfinalized  term";
  my $c   = bless {%$t};
  $c->{v} = {%{$t->{v}}};
  delete @$c{qw(id s z)};
  $c;
 }


=head3 split

Split a term into its components

=cut


sub split($)
 {my ($t) = @_;
  my $c = $t->clone;
  my @c = @$c{qw(sqrt divide exp log)};
          @$c{qw(sqrt divide exp log)} = ((undef()) x 4);
 (t=>$c, s=>$c[0], d=>$c[1], e=>$c[2], l=>$c[3]);
 }

lib/Math/Algebra/Symbols/Term.pm  view on Meta::CPAN

  $t->{z} or die "Attempt to use unfinalized term in cos";

  return $one  if   $t == $zero;
  return undef if   $t->{divide} or
                    $t->{sqrt}   or
                    $t->{exp}    or
                    $t->{log};
  return undef unless $t->{i} == 0;
  return undef unless scalar(keys(%{$t->{v}})) == 1;
  return undef unless exists($t->{v}{pi});
  return undef unless $t->{v}{pi} == 1;

  my $c = $t->{c};
  my $d = $t->{d};
  return undef unless $d== 1 or $d == 2 or $d == 3 or $d == 6;
  $c *= 6 if $d == 1;
  $c *= 3 if $d == 2;
  $c *= 2 if $d == 3;
  $c = $c % 12;

  return $half  if $c == 10;
  return undef  if $c == 11;
  return $one   if $c == 12;
  return $one   if $c ==  0;
  return undef  if $c ==  1;
  return $half  if $c ==  2;
  return $zero  if $c ==  3;
  return $mHalf if $c ==  4;
  return undef  if $c ==  5;
  return $mOne  if $c ==  6;
  return undef  if $c ==  7;
  return $mHalf if $c ==  8;
  return $zero  if $c ==  9;
 }


=head3 log2

Log of a term

=cut


sub log2($)
 {my ($a) = @_;

  $a->{z} or die "Attempt to use unfinalized term in log";

  return $zero if $a == $one;
  return undef;
 }


=head3 id

Get Id of a term

=cut


sub id($)
 {my ($t) = @_;
  $t->{id} or die "Term $t not yet finalized";
  $t->{id};
 }


=head3 zz

# Check term finalized

=cut


sub zz($)
 {my ($t) = @_;
  $t->{z} or die "Term $t not yet finalized";
  $t;
 }


=head3 z

Finalize creation of the term. Once a term has been finalized, it
becomes readonly, which allows optimization to be performed.

=cut


sub z($)
 {my ($t) = @_;
  !exists($t->{z}) or die "Already finalized this term";

  my $p  = $t->print;
  return $z{$p} if defined($z{$p});
  $z{$p} = $t;
  weaken($z{$p});                                                               # Greatly reduces memory usage

  $t->{s}  = $p;
  $t->{z}  = $t->signature;
  $t->{id} = ++$z;

#HashUtil   lock_hash(%{$t->{v}}) if $lock;
#HashUtil   lock_hash %$t         if $lock;
  $t;
 }

#sub DESTROY($)
# {my ($t) = @_;
#  delete $z{$t->{s}} if defined($t) and exists $t->{s};
# }

sub lockHashes()
 {my ($l) = @_;
#HashUtil   for my $t(values %z)
#HashUtil    {lock_hash(%{$t->{v}});
#HashUtil     lock_hash %$t;
#HashUtil    }
  $lock = 1;
 }


=head3 print

Print

=cut


sub print($)
 {my ($t) = @_;
  return $t->{s} if defined($t->{s});
  my @k = sort keys %{$t->{v}};                                                 # 2016/01/20 16:18:12 Added sort to make prints canonical
  my $v = $t->{v};
  my $s = '';