Definitely getting there! That's a lot of improvement in one month.
The best solution for this problem might depend on the sparseness of
your data. My philosophy, when I'm trying to write stylistic PDL code,
is to increase the dimensionality of the problem as much as necessary,
and then pare it down later. For this problem, that might create a lot
more overhead than your approach, especially if your hits are dense.
For example, my approach uses 'rvals' to create a distance vector for
every hit in every column, then finding the maximum closeness for each
element in that column. That's creating a 5 x (# hits per column)
piddle for every row. On the other hand, you have to deal with every
element in your result array individually.
Minimizing explicit loops is good, you've done that well here, and
you've made good use of slicing and dataflow (your .= assignments). But
any time you can get rid of element-by-element operations and let PDL's
internal optimized loops do the work, you will win points in style,
readability, and likely in speed.
cheers,
Derek
sub calcscore{
my $f = $_[0];
my $r = zeroes($f);
my $h = whichND($f)->qsortvec;
my $ysize = $f->dim(1);
foreach my $x($h->(0)->uniq->list){ #for every column
my $col = zeroes($ysize); #just something to get it started
foreach my $y($h->(1)->where($h->(0)==$x)->list){ #get the location
of every hit
#get the (10-distance) from that hit and glue it on to the previous. I
hard-coded the 10 in, not good style there.
$col = $col->glue(1,10-rvals($ysize,{center=>[$y]}));
}
$r(($x)).=$col->xchg(0,1)->maximum; #for each row in the column, you
want the closest, i.e., the highest number
}
return $r;
}
[EMAIL PROTECTED] wrote:
> I think I'm getting the hang of threading, but I'd appreciate if someone could
> double check me. I'm interested in speed, but also is it in good PDL style?
>
> I need to calculate 'closeness' scores for each location in a 2 dimensional
> piddle .
>
> For example, given the piddle
> [
> [1 0 0 1]
> [0 0 0 0]
> [0 1 1 0]
> [0 0 1 0]
> [0 0 1 1]
> ]
>
> The weights should be
>
> [
> [10 8 8 10]
> [ 9 9 9 9]
> [ 8 10 10 8]
> [ 7 9 10 9]
> [ 6 8 10 10]
> ]
>
> Every time I got a hit, then it's score 10. The cell above and below the hit
> is scored 9, the cell above and below that is 8 and so on.
>
> This is the routine that I've come up with:
>
> sub calcscore {
> my $f = $_[0];
> my @score = @{ $_[1] };
>
> # create a new piddle to store the results, the same size as the input
> my $r = zeroes dims $f;
>
> # record the width of the piddle.
>
> my $max = ( dims $f)[1] - 1;
>
> #create an empty array of piddles of the right size
>
> my @got;
>
> @got[ 2 * ( scalar @score - 1 ) ] = undef;
>
> # $got[0] is those which are hits
>
> $got[0] = whichND( $f != 0 );
> for my $i ( 1 .. scalar @score ) {
> $got[$i] = null;
> my $tmp = null;
> my $new = null;
> my $change = null;
>
> #calculate $got[+1] as those where the hit is 1 above
> $tmp .= $got[ $i - 1 ];
> $tmp->slice('1')--;
>
> # remove those which have gone off the edge
> $change = $tmp->slice('1') >= 0;
> $got[$i] .=
> $tmp->where( $change->dummy( 1, 2 )->transpose )
> ->reshape( 2, $change->sum );
>
> $got[ -$i ] = null;
> $tmp = null;
> $new = null;
> $change = null;
>
> #repeat for -1 where the hit is 1 below, and the other edge
>
> $tmp .= $got[ -$i + 1 ];
> $tmp->slice('1')++;
> $change .= $tmp->slice('1') <= $max;
> $got[ -$i ] .=
> $tmp->where( $change->dummy( 1, 2 )->transpose )
> ->reshape( 2, $change->sum );
> }
>
> # use the @got's to score each item. I do it in reverse so that
> # the overwrites are correcting earlier further aways
> foreach my $i ( reverse( 0 .. scalar @score ) ) {
> my $res = $r->indexND( $got[$i] );
> $res .= $score[$i];
>
> $res = $r->indexND( $got[ -$i ] );
> $res .= $score[$i];
> }
> return $r;
> }
>
> _______________________________________________
> Perldl mailing list
> [email protected]
> http://mailman.jach.hawaii.edu/mailman/listinfo/perldl
>
_______________________________________________
Perldl mailing list
[email protected]
http://mailman.jach.hawaii.edu/mailman/listinfo/perldl