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

Reply via email to