Lab-Measurement

 view release on metacpan or  search on metacpan

lib/Lab/Moose/DataFile/Read.pm  view on Meta::CPAN

$Lab::Moose::DataFile::Read::VERSION = '3.931';
#ABSTRACT: Read a gnuplot-style 2D data file

use v5.20;

use warnings;
use strict;
use MooseX::Params::Validate 'validated_list';
use Moose::Util::TypeConstraints 'enum';
use List::Util qw//;
use PDL;

#use PDL::Core qw/pdl cat dog/;
use Fcntl 'SEEK_SET';
use Carp;
use Exporter 'import';
use Data::Dumper;

our @EXPORT = qw/read_gnuplot_format/;


# produce 2D PDL for each block. Cat them into a 3d PDL
sub get_blocks {
    my ( $fh, $num_columns ) = validated_list(
        \@_,
        fh          => { isa => 'FileHandle', optional => 1 },
        num_columns => { isa => 'Int' },
    );

    my @blocks;
    my @rows;
    while ( my $line = <$fh> ) {
        if ( $line =~ /^#/ ) {
            next;
        }
        if ( $line =~ /^\s*$/ ) {

            # Finish block. Need check for number of rows if we have
            # multiple subsequent blank lines
            if ( @rows > 0 ) {

                # Give \@rows, not @rows to get a 2D piddle if we
                # only have a single row.
                push @blocks, pdl( \@rows );
                @rows = ();
            }
            next;
        }

        # awk splitting behaviour
        my @nums = split( ' ', $line );
        if ( @nums != $num_columns ) {
            die "num cols not $num_columns";
        }
        push @rows, [@nums];
    }
    if ( @rows > 0 ) {
        push @blocks, pdl( \@rows );
    }

    # bring blocks to same number of rows: reshape and add NaNs.
    my $max_rows = List::Util::max( map { ( $_->dims )[1] } @blocks );

    for my $block (@blocks) {
        my $rows = ( $block->dims() )[1];
        if ( $rows < $max_rows ) {
            $block->reshape( $num_columns, $max_rows );
            $block->slice(":,${rows}:-1") .= "NaN";
        }
    }

    return PDL::cat(@blocks);
}

sub read_gnuplot_format {
    my ( $type, $fh, $file, $num_columns ) = validated_list(
        \@_,
        type => { isa => enum( [qw/columns maps bare/] ) },
        fh          => { isa => 'FileHandle', optional => 1 },
        file        => { isa => 'Str',        optional => 1 },
        num_columns => { isa => 'Int' },
    );

    if ( !( $fh || $file ) ) {
        croak "read_2d_gnuplot_format needs either 'fh' or 'file' argument";
    }

    if ( !$fh ) {
        open $fh, '<', $file
            or croak "cannot open file $file: $!";
    }

    # Rewind filehandle.
    seek $fh, 0, SEEK_SET
        or croak "cannot seek: $!";

    my $blocks = get_blocks( fh => $fh, num_columns => $num_columns );

    # $blocks is 3D PDL with following dims
    # 0st dim: column
    # 1st dim: row (in block)
    # 2nd dim: block

    if ( $type eq 'bare' ) {
        return $blocks;
    }
    elsif ( $type eq 'columns' ) {

        # merge blocks
        my $result = $blocks->clump( 1, 2 );

        # switch row/column dimensions
        $result = $result->xchg( 0, 1 );

        # return one pdl for each column
        return dog($result);
    }
    elsif ( $type eq 'maps' ) {

        # 3D gnuplot data file (two x values, three y value):
        # x11 y11 z11
        # x12 y12 z12
        # x13 y13 z13
        #
        # x21 y21 z21
        # x22 y22 z22
        # x23 y23 z23
        #



( run in 0.965 second using v1.01-cache-2.11-cpan-39bf76dae61 )