Re^2: Uninitialized warnings trouble

Don't know if next version with planes (tables) rotation subroutine is "cooler". It's longer, but maybe intention is more clear. It does proper rotation this time, instead of reflection, slightly more work and doesn't affect final result.

use strict;
use warnings;
use PDL;

sub turn_tables {
    my ( $pdl, $dir ) = @_;     # dir = 0   => cw
                                #       1   => ccw

    my @s = ( undef, map $pdl-> slice( "X, X, $_" ), 1 .. 3 );
    my @a = $dir ? ( 1, 2, 3 ) : ( 3, 2, 1 );
    
    $s[ $a[0]] .= $s[ $a[0]]-> copy
                            -> transpose-> slice( '-1:0, X' );  # 90
    $s[ $a[1]] .= $s[ $a[1]]-> copy
                            -> slice( '-1:0, -1:0' );           # 180
    $s[ $a[2]] .= $s[ $a[2]]-> copy
                            -> slice( '-1:0, X' )-> transpose;  # 270
}

my $trees = 1 + rcols *DATA, 
    { COLSEP => qr//, KEEP => qr/^\d+$/ }, [];
my $size = max shape $trees;
$trees-> reshape(( $size ) x 2 );

my $SLTM = identity( $size )
    -> cumusumover
    -> xor( identity $size )
    -> transpose;
    
my $t4 = $trees-> dummy( -1, 4 )-> copy;
turn_tables( $t4 );
my $cummax = maxover $SLTM * $t4-> dummy( 1 );
my $seen   = $t4 > $cummax;
turn_tables( $seen, 1 );

print $seen-> mv( -1, 0 )-> orover-> sum;

__END__
0021000302223413032321152215243115022004032344522041252513450244235444
+43305142410110142101223120110
... skipped, see 11148843
[download]

Comment on Re^2: Uninitialized warnings trouble Download Code

Replies are listed 'Best First'.

Re^3: Uninitialized warnings trouble
by Anonymous Monk on Dec 15, 2022 at 20:33 UTC

This next version of turn_tables seems less ugly.

sub turn_tables {
    my ( $pdl, $dir ) = @_;     # dir = 0   => forward
                                #       1   => backward
    my @t = (   # transform
        sub { $_[0]-> copy-> transpose-> slice( '-1:0, X' )},   # 90
        sub { $_[0]-> copy-> slice( '-1:0, -1:0' )},            # 180
        sub { $_[0]-> copy-> transpose-> slice( 'X, -1:0' )},   # 270 
    );
    @t = reverse @t if $dir;

    for ( 1 .. 3 ) {
        my $s = $pdl-> slice( "X, X, $_" );
        $s .= $t[ $_ - 1 ]-> ( $s )
    }
}
[download]

[reply]
[d/l]
[select]


Just another Perl shrine
	PerlMonks