view release on metacpan or  search on metacpan

Entanglement.pm  view on Meta::CPAN

}

# any MUTating OPerator
sub mutop {
  my $c = $_[0];
  my $code = $_[1];
  my $os = $c->[1];
  my $universe = ${$c->[0]};
  foreach my $state (@$universe) {
    $state->[$os] = &$code($state->[$os]);
  }
  return $c;
}

sub unnop {
  my $c = $_[0];
  my $code = $_[1];
  my $os = $c->[1];
  my $val = $c->_add; my $universe = ${$c->[0]};
  foreach my $state (@$universe) {
    push(@$state, $state->[$os-1], &$code($state->[$os]) );
  }
  return $val;
}

##
# performing a conditional in paralell on the states (ie. without looking)
# returns a new variable

sub p_op {
  my ($arg1, $op, $arg2, $true_cf, $false_cf) = @_;
  $true_cf  = ref($true_cf)  ? $true_cf  : sub {1};
  $false_cf = ref($false_cf) ? $false_cf : sub {0};
  my $r = 0;
  unless (ref($arg1) && UNIVERSAL::isa($arg1, 'Quantum::Entanglement')) {
    $r = 1;
    ($arg1, $arg2) = ($arg2, $arg1);
  }
  my $tcref;
  eval "
     \$tcref = sub {
       local \*QE::arg1 = \\\$_[0];
       local \*QE::arg2 = \\\$_[1];
       if (\$_[0] $op \$_[1]) {
         return \&\$true_cf;
       }
       else {
         return \&\$false_cf;
       }
     }
  "; croak "$0: something wrong in p_op $@" if $@;

  return binop($arg1, $arg2, $r, $tcref);
}

# allows for other functions to be performed accross states, can take
# as many entangled variables as you like...
# can take code ref, or "symbolic" function name (eg. p_func('substr', ..))
sub p_func {
  my $func = shift;
  my $package = (caller)[0];
  # build up the function call by shifting off
  # entangled variables until something isn't entangled
  my $foo = ref($func) ? "&\$func(" : "$func(";
  my @temp = @_;
  my $first = $temp[0];
  do {
    my $c = shift @temp;
    _join($first,$c);
  } while (ref($temp[0]) && UNIVERSAL::isa($temp[0],'Quantum::Entanglement'));
  my @p_codes = ();
  do {
    my $c = shift;
    $foo .= '$state->[' . $c->[1] . '],';
    push @p_codes, $c->[1]-1;
  } while ( ref($_[0]) && UNIVERSAL::isa($_[0], 'Quantum::Entanglement'));
  $foo .= scalar(@_)? '@args);' : ');';
  my @args = @_;
  # loop over states, evaluating function in caller's package
  my $var = $first->_add;
  my $p_code = join('*', map {"\$state->[$_]"} @p_codes);
  my $universe = ${$first->[0]};
  foreach my $state (@$universe) {
    my $new_prob = eval $p_code;
    push(@$state, $new_prob, eval "package $package; $foo");
    croak "Internal error: $@" if $@;
  }
  return $var;
}

# This allows the introduction of new states into the system, based
# on the current values and probability amplitudes of current states
# must be given a code ref, followed by a list of entangled vars whose
# states will be passed to the function.
sub q_logic {
  my $func = shift;
  my (@offsets);
  my $first = $_[0];
  _join($first,$_) foreach @_;
  @offsets = map {$_->[1]-1, $_->[1]} @_;
  my $var = $first->_add;
  my $universe = ${$first->[0]};
  my @resultant_space;
  foreach my $state (@$universe) {
    my @new_states = &$func(@{$state}[@offsets]);
    do {
      push @resultant_space, [@$state, splice(@new_states,0,2)];
    } while (@new_states);
  }
  @{$universe} = @resultant_space;
  return $var;
}

# takes ft of amplitudes of a var, creates new state with the
# transformed amplitudes and the values from the first state.
sub QFT {
  my $c = $_[0];
  my $var = $c->_add;
  my $os = $c->[1];
  my $universe = ${$c->[0]};
  my @inputs = map {$_->[$os-1]} @$universe; # get current probs