view release on metacpan or  search on metacpan

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

    );
    #### %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;
    my $coeff_col   = shift;
    my $tax_col     = shift;

    my $palette;
    my $color_n;
    my $tic;
    my $column;
    my $limit;
    my $comparison;

    if (uc($coloration) eq 'O') {
        $palette = $org_col->{palette};
        $color_n = $org_col->{color_n};
        $tic = undef;
        $column = 3;
        $limit = $self->max_copy;
        $comparison = "<";
    }

    elsif (uc($coloration) eq 'T') {
        $palette = $tax_col->{palette};
        $color_n = $tax_col->{color_n};
        $tic = $tax_col->{tic};
        $column = 6;
        $limit = '$6';
        $comparison = "=";
    }

    elsif (uc($coloration) eq 'A') {
        $palette = $coeff_col->{palette_hmm};
        $color_n = $coeff_col->{color_n_hmm};
        $tic = $coeff_col->{tic_hmm};
        $column = 4;
        $limit = $self->min_cov;
        $comparison = ">";
    }

    elsif (uc($coloration) eq 'G') {
        $palette = $coeff_col->{palette_hmm};
        $color_n = $coeff_col->{color_n_hmm};
        $tic = $coeff_col->{tic_hmm};
        $column = 4;
        $limit = $self->min_cov;
        $comparison = ">";
    }

    my $vars = {
        palette    => $palette,
        color_n    => $color_n,
        tic        => $tic,