view release on metacpan or  search on metacpan

lib/App/Rangeops/Command/connect.pm  view on Meta::CPAN

package App::Rangeops::Command::connect;
use strict;
use warnings;
use autodie;

use App::Rangeops -command;
use App::Rangeops::Common;

sub abstract {
    return 'connect bilaterial links into multilateral ones';
}

sub opt_spec {
    return (
        [ "outfile|o=s", "Output filename. [stdout] for screen." ],
        [   "ratio|r=f",
            "Break links if length identities less than this ratio, default is [0.9].",
            { default => 0.9 }
        ],
        [ "numeric|n", "Sort chromosome names numerically.", ],
        [ "verbose|v", "Verbose mode.", ],
    );
}

sub usage_desc {
    return "rangeops connect [options] <infiles>";
}

sub description {
    my $desc;
    $desc .= ucfirst(abstract) . ".\n";
    $desc .= "\t<infiles> are bilaterial links files without hit strands\n";
    return $desc;
}

sub validate_args {
    my ( $self, $opt, $args ) = @_;

    if ( !@{$args} ) {
        $self->usage_error("This command need one or more input files.");
    }
    for ( @{$args} ) {
        next if lc $_ eq "stdin";
        if ( !Path::Tiny::path($_)->is_file ) {
            $self->usage_error("The input file [$_] doesn't exist.");
        }
    }

    if ( !exists $opt->{outfile} ) {
        $opt->{outfile}
            = Path::Tiny::path( $args->[0] )->absolute . ".cc.tsv";
    }
}

sub execute {
    my ( $self, $opt, $args ) = @_;

    #----------------------------#
    # Loading
    #----------------------------#
    my $graph = Graph->new( directed => 0 );
    my $info_of = {};    # info of ranges
    for my $file ( @{$args} ) {
        for my $line ( App::RL::Common::read_lines($file) ) {
            $info_of = App::Rangeops::Common::build_info( [$line], $info_of );

            my @parts;
            for my $part ( split /\t/, $line ) {
                next unless exists $info_of->{$part};
                push @parts, $part;
            }

            # all ranges will be converted to positive strands
            next unless @parts == 2;

            my %new_0 = %{ $info_of->{ $parts[0] } };
            my %new_1 = %{ $info_of->{ $parts[1] } };

            my @strands;
            my $hit_strand = "+";
            {
                push @strands, $new_0{strand};
                push @strands, $new_1{strand};
                @strands = List::MoreUtils::PP::uniq(@strands);

                if ( @strands != 1 ) {
                    $hit_strand = "-";
                }

                $new_0{strand} = "+";
                $new_1{strand} = "+";
            }

            my $range_0 = App::RL::Common::encode_header( \%new_0, 1 );
            $info_of->{$range_0} = \%new_0;
            my $range_1 = App::RL::Common::encode_header( \%new_1, 1 );