speed-up PDL::Factor and PDL::SV's new() a little bit

Author: iynehz

Changes

@@ -1,5 +1,9 @@
 Revision history of Alt-Data-Frame-ButMore
 
+0.0050_02   2019-05-29
+    - Speed-up PDL::Factor and PDL::SV's new() a little bit. In this work we
+      removed Data::Rmap from dependencies. Data::Rmap has a lot overhead.
+
 0.0050_01   2019-05-29
     - Fix PDL::Factor's repeat() method.
     - Fix Data::Frame's comparison on negative numerical values.

cpanfile

@@ -1,7 +1,6 @@
 requires "Carp" => "0";
 requires "Class::Method::Modifiers" => "0";
 requires "Data::Dumper" => "0";
-requires "Data::Rmap" => "0";
 requires "Devel::OverloadInfo" => "0.005";
 requires "Eval::Quosure" => "0.001001";
 requires "Exporter::Tiny" => "0";
@@ -35,7 +34,6 @@ requires "Safe::Isa" => "1.000009";
 requires "Scalar::Util" => "0";
 requires "Sereal::Decoder" => "4.005";
 requires "Sereal::Encoder" => "4.005";
-requires "Storable" => "0";
 requires "Syntax::Keyword::Try" => "0.09";
 requires "Test2::API" => "0";
 requires "Test2::Util::Ref" => "0";

dist.ini

@@ -4,7 +4,7 @@ author  = Stephan Loyd <[email protected]>
 license = Perl_5
 copyright_holder = Zakariyya Mughal, Stephan Loyd
 copyright_year   = 2014, 2019
-version = 0.0050_01
+version = 0.0050_02
 
 ; authordep Pod::Weaver::PluginBundle::SLOYD = 0.0005
 ; authordep Pod::POM = 2.01

lib/PDL/Factor.pm

@@ -11,11 +11,9 @@ use PDL::Lite ();   # PDL::Lite is the minimal to get PDL work
 use PDL::Core qw(pdl);
 use PDL::Primitive qw(which);
 
-use Data::Rmap qw(rmap);
 use Module::Load;
 use Ref::Util qw(is_plain_arrayref);
 use Safe::Isa;
-use Storable qw(dclone);
 use Scalar::Util qw(blessed);
 use Type::Params;
 use Types::Standard qw(slurpy ArrayRef ConsumerOf Int);
@@ -99,21 +97,28 @@ sub new {
             return $data->copy;
         }
 
+        #TODO: this does not support ND piddle yet.
+
         # reorder levels
         my @levels      = @{ delete $opt{levels} };
         my @integer_old = $data->{PDL}->list;
-        my $i           = 0;
-        my %levels_old  = map { $i++ => $_ } @{ $data->levels };
-        $i = 0;
-        my %levels_new  = map { $_ => $i++ } @levels;
-        my @integer_new = map {
-            my $enum = $levels_old{$_};
-            defined $enum ? $levels_new{$enum} : -1;
-        } @integer_old;
-
-        my $new = $class->new( \@levels, levels => \@levels, %opt );
+        my @levels_old = @{ $data->levels };
+        my %levels_new = do {
+            my $i = 0;
+            map { $_ => $i++ } @levels;
+        };
+        my @integer_new = do {
+            no warnings 'numeric';
+            map {
+                my $level = $levels_old[$_];
+                defined $level ? $levels_new{$level} : -1;
+            } @integer_old;
+        };
+
+        my $new = $class->new( [ $levels[0] ], levels => \@levels, %opt );
         my $p = PDL::Core::indx( \@integer_new );
-        $new->{PDL} = $p->setbadif( $p < 0 );
+        $p = $p->setbadif( $data->isbad ) if $data->badflag;
+        $new->{PDL} = $p;
         return $new;
     }
 
@@ -132,12 +137,20 @@ sub new {
         $levels = $class->_extract_levels($enum);
     }
 
-    $enum = $enum->$_DOES('PDL') ? $enum->unpdl : dclone($enum);
-    my $i = 0;
-    my %levels = map { $_ => $i++; } @$levels;
-    rmap {
-        $_ = ($levels{$_} // -1); # assign index of level
-    } $enum;
+    # this is faster than Data::Rmap::rmap().
+    state $rmap = sub {
+        my ( $x, $levels ) = @_;
+        is_plain_arrayref($x)
+          ? [ map { __SUB__->( $_, $levels ) } @$x ]
+          : ( $levels->{$x} // -1 );
+    };
+
+    my %levels = do {
+        my $i = 0;
+        map { $_ => $i++; } @$levels;
+    };
+    $enum =
+      $rmap->( ( $enum->$_DOES('PDL') ? $enum->unpdl : $enum ), \%levels );
 
     my $self = $class->initialize();
 

lib/PDL/Logical.pm

@@ -8,7 +8,7 @@ use warnings;
 use PDL::Lite ();   # PDL::Lite is the minimal to get PDL work
 use PDL::Core qw(pdl);
 
-use Data::Rmap qw(rmap_array);
+use Ref::Util qw(is_plain_arrayref);
 use Safe::Isa;
 
 use parent 'PDL';
@@ -26,14 +26,17 @@ sub new {
     if ( $data->$_DOES('PDL') ) {
         $data = !!$data;
     }
-    elsif ( ref($data) eq 'ARRAY' ) {
-        my ($data1) = rmap_array {
-            ( ref( $_->[0] ) eq 'ARRAY' )
-              ? [ $_[0]->recurse() ]
-              : [ map { $_ ? 1 : 0 } @$_ ];
-        }
-        $data;
-        $data = pdl($data1);
+    elsif ( is_plain_arrayref($data) ) {
+
+        # this is faster than Data::Rmap::rmap().
+        state $rmap = sub {
+            my ($x) = @_;
+            is_plain_arrayref($x)
+              ? [ map { __SUB__->($_) } @$x ]
+              : ( $x ? 1 : 0 );
+        };
+
+        $data = pdl( $rmap->($data) );
     }
     else {
         $data = pdl( $data ? 1 : 0 );

lib/PDL/SV.pm

@@ -9,8 +9,7 @@ use PDL::Lite ();   # PDL::Lite is the minimal to get PDL work
 use PDL::Core qw(pdl);
 use PDL::Primitive qw(which whichND);
 
-use Data::Rmap qw(rmap_array);
-use Ref::Util;
+use Ref::Util qw(is_plain_arrayref);
 use Safe::Isa;
 use Type::Params;
 use Types::Standard qw(slurpy ArrayRef ConsumerOf Int);
@@ -79,12 +78,14 @@ sub new {
     my ( $class, @args ) = @_;
     my $data = shift @args;    # first arg
 
-    my ($faked_data) = rmap_array {
-        Ref::Util::is_plain_arrayref( $_->[0] )
-          ? [ $_[0]->recurse() ]
-          : [ (0) x @$_ ]
-    }
-    $data;
+    state $rmap = sub {
+        my ( $x ) = @_; 
+        is_plain_arrayref($x)
+          ? [ map { __SUB__->( $_ ) } @$x ]
+          : 0;
+    };  
+
+    my $faked_data = $rmap->($data);
 
     my $self = $class->initialize();
     my $pdl  = $self->{PDL};
@@ -259,22 +260,19 @@ sub at {
 sub unpdl {
     my $self = shift;
 
-    my $data     = $self->{PDL}->unpdl;
+    state $rmap = sub {
+        my ( $x, $f ) = @_;
+        is_plain_arrayref($x)
+          ? [ map { __SUB__->( $_, $f ) } @$x ]
+          : $f->($x);
+    };
+
     my $internal = $self->_internal;
-    if ($self->ndims == 1) {    # for speed
-        my $f =
-          $self->badflag
-          ? sub { $_ eq 'BAD' ? 'BAD' : $internal->[$_] }
-          : sub { $internal->[$_] };
-        $data = [ map { $f->($_) } @$data ];
-    } else {
-        my $f =
-          $self->badflag
-          ? sub { $_ = ( $_ eq 'BAD' ? 'BAD' : $internal->[$_] ); }
-          : sub { $_ = $internal->[$_] };
-        Data::Rmap::rmap_scalar { $f->($_) } $data;
-    }
-    return $data;
+    my $f =
+      $self->badflag
+      ? sub { $_ eq 'BAD' ? 'BAD' : $internal->[$_] }
+      : sub { $internal->[$_] };
+    return $rmap->( $self->{PDL}->unpdl, $f );
 }
 
 =head2 list