File Coverage

blib/lib/PDL/SV.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package PDL::SV;
2             $PDL::SV::VERSION = '0.001';
3 1     1   68207 use strict;
  1         2  
  1         29  
4 1     1   4 use warnings;
  1         2  
  1         20  
5              
6 1     1   551 use Moo;
  1         12397  
  1         6  
7 1     1   2281 use PDL::Lite;
  0            
  0            
8             use MooX::InsideOut;
9             use Data::Rmap qw(rmap_array);
10             use Storable qw(dclone);
11             use List::AllUtils ();
12              
13             extends 'PDL';
14             with qw(PDL::Role::Stringifiable);
15              
16             # after stringifiable role is added, the string method will exist
17             eval q{
18             use overload ( '""' => \&PDL::SV::string );
19             };
20              
21             has _internal => ( is => 'rw', default => sub { [] } );
22              
23             around new => sub {
24             my $orig = shift;
25             my ($class, @args) = @_;
26             my $data = shift @args; # first arg
27              
28             my $faked_data = dclone($data);
29             rmap_array { $_ = [ (0)x@$_ ] } $faked_data;
30              
31             unshift @args, _data => $faked_data;
32              
33             my $self = $orig->($class, @args);
34              
35             $self .= $self->sequence( $self->dims );
36              
37             my $nelem = $self->nelem;
38             for my $idx (0..$nelem-1) {
39             my @where = PDL::Core::pdl($self->one2nd($idx))->list;
40             $self->_internal()->[$idx] = $self->_array_get( $data, @where );
41             }
42              
43             $self;
44             };
45              
46             #sub initialize {
47             #bless { PDL => null }, shift;
48             #}
49              
50             # code modified from
51             sub _array_get {
52             my ($self, $array, @indices) = @_;
53             return $array unless scalar @indices;
54             my $return_value = $array->[ $indices[0] ];
55             for (1 .. (scalar @indices - 1)) {
56             $return_value = $return_value->[ $indices[$_] ];
57             }
58             return $return_value;
59             }
60              
61             around qw(slice dice uniq) => sub {
62             my $orig = shift;
63             my ($self) = @_;
64             my $ret = $orig->(@_);
65             # TODO _internal needs to be copied
66             $ret->_internal( $self->_internal );
67             $ret;
68             };
69              
70             around qw(sever) => sub {
71             # TODO
72             # clone the contents of _internal
73             # renumber the elements
74             };
75              
76              
77             sub FOREIGNBUILDARGS {
78             my ($self, %args) = @_;
79             ( $args{_data} );
80             }
81              
82             around at => sub {
83             my $orig = shift;
84             my ($self) = @_;
85              
86             my $data = $orig->(@_);
87             $self->_internal->[$data];
88             };
89              
90             around unpdl => sub {
91             my $orig = shift;
92             my ($self) = @_;
93              
94             my $data = $orig->(@_);
95             Data::Rmap::rmap_scalar(sub {
96             $_ = $self->_internal->[$_];
97             }, $data);
98             $data;
99             };
100              
101             sub element_stringify_max_width {
102             my ($self, $element) = @_;
103             my @where = @{ $self->uniq->SUPER::unpdl };
104             my @which = @{ $self->_internal }[@where];
105             my @lengths = map { length $_ } @which;
106             List::AllUtils::max( @lengths );
107             }
108              
109              
110             1;
111              
112             __END__