Hello all -
A friend of mine once speculated that it would be cool to be able to
update a piddle in the pdl shell and have the corresponding plot
immediately update itself. I thought about it for a second and said,
"I'll bet you could do that with some fancy slice operation." Well, I
am happy to say that I have a first cut at such a slice operation. The
code below implements it using Inline::Pdlpp so you can try it out.
Basically, it allows you to carry around a piddle that 'knows' when
you've updated it, and which calls a customized callback. The callback
is a typical Perl sub ref, which means it knows about its surrounding
variables. However, it does not get any arguments, for reasons that
you'll see if you look closely at the first wart.
I would like to clean this up (checks for nan, bad value handling,
etc) and have this added to PDL::Slices. Thoughts?
@Porters and wizards: in order to get at the code ref in the BackCode
section, I had to go explicitly through __privtrans. That seems
hackish. Is there a better way to do this?
David
use strict;
use warnings;
use PDL;
use Inline 'Pdlpp';
use PDL::NiceSlice;
###############
# Basic Usage #
###############
# Create a 'ghost' piddle called _x:
my $_x = sequence(20);
# Monitor _x by wrapping it with a callback piddle called x:
my $update_counter = 0;
my $x = $_x->callback(sub {
$update_counter++;
print "Detected update number $update_counter: $_x\n";
});
# Any changes in x will lead to a print statement:
$x++;
$x->set(0, -10);
# Updates to *slices* of x also call the callback:
$x(5:10) -= 30;
# Simply using x does not lead to the callback (this will not print a line):
my $y = $x + 10;
print "Done with basic usage\n";
############################################################
# Wart - Stringing together the construction does not work #
############################################################
# You would think you could string together such a declaration like this,
# but it doesn't work:
my $z = sequence(20)->callback( sub { "Changed z!\n" });
print "z is $z; incrementing\n";
# Notice, this never calls the callback!
$z++;
print "z is now $z\n";
######################################################
# Partial Wart - cannot print out parents of parents #
######################################################
my $a = sequence(20);
# A non-affine slice:
my $b = $a->where($a < 10);
# create a callback piddle that monitors changes to itself:
my $c = $b->callback( sub {
print "Changed c\n";
print "During the callback, b is $b\n";
print "During the callback, a is $a\n";
});
$c++;
print "After the increment, a is $a\n";
no PDL::NiceSlice;
__END__
__Pdlpp__
pp_def('callback',
Pars => 'p();[o] c(); ',
OtherPars => 'SV * code_ref',
DefaultFlow => 1,
Reversible => 1,
# Main code is easy -- just copy the data
Code => q{
$c() = $p();
},
BackCode => q{
/* We'll only call back if there is a change */
int data_changed = 0;
threadloop %{
/* Check if the child changed */
if ($c() != $p()) {
$p() = $c();
data_changed = 1;
}
%}
/* If the data changed, call the callback */
if (data_changed) {
dSP; /* Get at Perl's argument stack */
ENTER; /* */
SAVETMPS; /* Equivalent of left curly bracket */
PUSHMARK(SP); /* */
PUTBACK;
call_sv(__privtrans->code_ref, G_VOID);
SPAGAIN;
FREETMPS;
LEAVE;
}
},
);
_______________________________________________
Perldl mailing list
[email protected]
http://mailman.jach.hawaii.edu/mailman/listinfo/perldl
