view release on metacpan or  search on metacpan

lib/Bio/MUST/Apps/OmpaPa/Roles/Parsable.pm  view on Meta::CPAN

    my $qlen;

    HIT:
    for my $hit ($self->all_hits) {
        $top = $hit->{qlen} * 1.5;
        $bottom = $hit->{qlen} * 0.5;
        $qlen = $hit->{qlen};
        last HIT if ($qlen);
    }

    my %return = (
        color_n_hmm => $color_n_hmm,
        palette_hmm => $palette_hmm,
        tic_hmm     => $tic_hmm,
        top         => $top,
        bottom      => $bottom,
        qlen        => $qlen
    );

    return \%return;
}

sub _org_col {
    my $self = shift;

    my @ids = map { $_->{acc} } $self->all_hits;
    my @orgs = map { (split m{\|}xms, $_)[0] } @ids;
    my %count_orgs;

    for my $org (@orgs) {
        $count_orgs{$org}++;
    }

    my $nb_org_tot = keys %count_orgs;
    my $max = (sort {$a <=> $b} values %count_orgs)[$nb_org_tot-1];
    my $color_n = $max;         # range scale palette
    # limit coloration: 3 (default) or more times the same organism in yellow
    my $limit = $self->max_copy;
    # if black: bug!
    my $palette = "0 \t 'black', 1 \t 'red', $limit \t 'yellow', $max \t 'yellow'";

    if ($limit > $max) {
        $palette = "0 \t 'black', 1 \t 'red', $max \t 'yellow'";

        if ($max == 1) {
            $palette = "0 \t 'black', 1 \t 'red'";
        }
    }

    my %return = (
        color_n  => $color_n,
        palette  => $palette,
    );

    return \%return;
}

sub _tax_col {
    my $self = shift;

    # make palette for legend
    my $scheme = $self->scheme;
    my $color_n = $scheme->count_colors;        # range scale palette
    my %color_for = $scheme->all_icols;
    #### %color_for

    # TODO: exclude black specs?
    # TODO: warn of dupe specs
    my %colorcode_for = (
                           0 => '#000000',      # unclassified hit = black
        map { $color_for{$_} => $_ } keys %color_for
    );
    #### %colorcode_for

    my @strings;
    my $inc = 0;
    for my $num ( sort {$a <=> $b} keys %colorcode_for ) {
        push @strings, ($num-$inc) . "\t \"" . $colorcode_for{$num} . q{"};
        $inc ||= $inc + 0.5;
        push @strings, ($num+$inc) . "\t \"" . $colorcode_for{$num} . q{"};
    }
    #### @strings
    my $palette = join q{,}, @strings;

    # make labels for legend
    my @names = $scheme->all_names;

    my @tics;
    for my $label (@names) {
        my $index = $self->scheme->icol_for( $scheme->color_for($label) );
        my $string = q{"} . $label . qq{" \t} . $index;
        push @tics, $string;
    }
    my $tic_str = join q{,}, @tics;

    my %return = (
        color_n  => $color_n + 0.5,
        palette  => $palette,
        tic      => $tic_str,
    );

    return \%return;
}

sub _template_gnuplot {
    my $self = shift;

    # different template given the coloration asked
    my $template = <<'EOT';
x = "-log10(evalue)"
y = "hit length"
[% IF print %]set terminal pdf enhanced font ",8"
set output "[% report %].[% suffix %]_[% coloration %].pdf"
[% ELSE %]set term [% term %] title "OmpaPa: [% report %]"
[% END %]set format "%.0f"
set mouse mouseformat x . ": %3.0f | " . y . ": %4.0f"
set size square
#set title "average length of top-25% hits: [% avg_len %]"
set title "Selected hits given hit length and evalue and with \n [% coloration %] coloration"
set grid x y
set xlabel x
set ylabel y
set arrow 1 from graph 0, first [% top %] to graph 1, first [% top %] nohead [% dt %]
set arrow 2 from graph 0, first [% bottom %] to graph 1, first [% bottom %] nohead [% dt %]
set arrow 3 from graph 0, first [% qlen %] to graph 1, first [% qlen %] nohead [% dt %] lc rgb "blue"
set cbrange[0:[% range %]]
[% IF tic %]set cbtics ([% tic %])
[% ELSE %]unset cbtics
set cbtics
[% END %]set palette defined ([% palette %])
[% IF print %][% IF global %][% IF all %]plot "[% data_file %]" using 1:2:[% column %] notitle with points pt 7 ps .2 palette
[% ELSE %]plot "[% data_file %]" using 1:($[% column %] [%comparison %]= [% limit %] && $3 <= [% global %] ? $2 : 1/0):[% column %] notitle with points pt 7 ps .2 palette[% END %]
[% ELSE %]plot "[% data_file %]" using 1:($[% column %] [%comparison %]= [% limit %] ? $2 : 1/0):[% column %] notitle with points pt 7 ps .2 palette[% END %]
[% ELSE %][% IF global %]plot "[% data_file %]" using 1:($[% column %] [%comparison %]= [% limit %] && $3 <= [% global %] ? $2 : 1/0):[% column %] notitle with points pt 7 ps 1 palette
[% ELSE %]plot "[% data_file %]" using 1:($[% column %] [%comparison %]= [% limit %] ? $2 : 1/0):[% column %] notitle with points pt 7 ps 1 palette[% END %][% END %]
EOT

    return $template;
}


sub _set_col_variables {
    my $self        = shift;
    my $coloration  = shift;
    my $org_col     = shift;