view release on metacpan or  search on metacpan

lib/App/Fasops/Command/xlsx.pm  view on Meta::CPAN

            my @full_names;
            my $seq_refs = [];

            for my $key ( keys %{$info_of} ) {
                push @full_names, $key;
                push @{$seq_refs}, $info_of->{$key}{seq};
            }

            if ( $opt->{length} ) {
                next if length $info_of->{ $full_names[0] }{seq} < $opt->{length};
            }

            print "Section [$opt->{section}]\n";
            $max_name_length = List::Util::max( $max_name_length, map {length} @full_names );

            # including indels and snps
            my $vars = get_vars( $seq_refs, $opt );
            $opt->{section} = paint_vars( $worksheet, $format_of, $opt, $vars, \@full_names );

        }
        else {
            $content .= $line;
        }
    }

    $in_fh->close;

    # format column
    $worksheet->set_column( 0, 0, $max_name_length + 1 );
    $worksheet->set_column( 1, $opt->{wrap} + 3, 1.6 );

    return;
}

# Excel formats
sub create_formats {

    #@type Excel::Writer::XLSX
    my $workbook = shift;

    my $format_of = {};

    # species name
    $format_of->{name} = $workbook->add_format(
        font => 'Courier New',
        size => 10,
    );

    # variation position
    $format_of->{pos} = $workbook->add_format(
        font     => 'Courier New',
        size     => 8,
        align    => 'center',
        valign   => 'vcenter',
        rotation => 90,
    );

    $format_of->{snp}   = {};
    $format_of->{indel} = {};

    # background
    my $bg_of = {};

    # 15
    my @colors = (
        22,    # Gray-25%, silver
        43,    # Light Yellow       0b001
        42,    # Light Green        0b010
        27,    # Lite Turquoise
        44,    # Pale Blue          0b100
        46,    # Lavender
        47,    # Tan
        24,    # Periwinkle
        49,    # Aqua
        51,    # Gold
        45,    # Rose
        52,    # Light Orange
        26,    # Ivory
        29,    # Coral
        31,    # Ice Blue

        #        30,    # Ocean Blue
        #        41,    # Light Turquoise, again
        #        48,    # Light Blue
        #        50,    # Lime
        #        54,    # Blue-Gray
        #        62,    # Indigo
    );

    for my $i ( 0 .. $#colors ) {
        $bg_of->{$i}{bg_color} = $colors[$i];

    }
    $bg_of->{unknown}{bg_color} = 9;    # White

    # snp base
    my $snp_fg_of = {
        'A' => { color => 58, },        # Dark Green
        'C' => { color => 18, },        # Dark Blue
        'G' => { color => 28, },        # Dark Purple
        'T' => { color => 16, },        # Dark Red
        'N' => { color => 8, },         # Black
        '-' => { color => 8, },         # Black
    };

    for my $fg ( keys %{$snp_fg_of} ) {
        for my $bg ( keys %{$bg_of} ) {
            $format_of->{snp}{"$fg$bg"} = $workbook->add_format(
                font   => 'Courier New',
                size   => 10,
                align  => 'center',
                valign => 'vcenter',
                %{ $snp_fg_of->{$fg} },
                %{ $bg_of->{$bg} },
            );
        }
    }
    $format_of->{snp}{'-'} = $workbook->add_format(
        font   => 'Courier New',
        size   => 10,
        align  => 'center',

lib/App/Fasops/Command/xlsx.pm  view on Meta::CPAN

        }

        $site->{var_type} = 'snp';
        $variations{ $site->{snp_pos} } = $site;
    }

    return \%variations;
}

# write excel
sub paint_vars {

    #@type Excel::Writer::XLSX::Worksheet
    my $sheet     = shift;
    my $format_of = shift;
    my $opt       = shift;
    my $vars      = shift;
    my $name_refs = shift;

    my $section_start = $opt->{section};
    my $color_loop    = $opt->{colors};

    my %variations     = %{$vars};
    my $section_cur    = $section_start;
    my $col_cursor     = 1;
    my $section_height = ( scalar( @{$name_refs} ) + 1 ) + $opt->{spacing};
    my $seq_count      = scalar @{$name_refs};
    $seq_count-- if $opt->{outgroup};

    for my $pos ( sort { $a <=> $b } keys %variations ) {
        my $var = $variations{$pos};
        my $pos_row = $section_height * ( $section_cur - 1 );

        # write SNPs
        if ( $var->{var_type} eq 'snp' ) {

            # write position
            $sheet->write( $pos_row, $col_cursor, $var->{snp_pos}, $format_of->{pos} );

            for my $i ( 1 .. $seq_count ) {
                my $base = substr $var->{snp_all_bases}, $i - 1, 1;

                my $occ
                    = $var->{snp_occured} eq "unknown"
                    ? 0
                    : substr( $var->{snp_occured}, $i - 1, 1 );

                if ( $occ eq "1" ) {
                    my $bg_idx     = oct( '0b' . $var->{snp_occured} ) % $color_loop;
                    my $base_color = $base . $bg_idx;
                    $sheet->write( $pos_row + $i,
                        $col_cursor, $base, $format_of->{snp}{$base_color} );
                }
                else {
                    my $base_color = $base . "unknown";
                    $sheet->write( $pos_row + $i,
                        $col_cursor, $base, $format_of->{snp}{$base_color} );
                }
            }

            # outgroup bases with no background colors
            if ( $opt->{outgroup} ) {
                my $base_color = $var->{snp_outgroup_base} . "unknown";
                $sheet->write(
                    $pos_row + $seq_count + 1,
                    $col_cursor,
                    $var->{snp_outgroup_base},
                    $format_of->{snp}{$base_color}
                );
            }

            # increase column cursor
            $col_cursor++;
        }

        # write indels
        if ( $var->{var_type} eq 'indel' ) {

            # how many column does this indel take up
            my $col_taken = List::Util::min( $var->{indel_length}, 3 );

            # if exceed the wrap limit, start a new section
            if ( $col_cursor + $col_taken > $opt->{wrap} ) {
                $col_cursor = 1;
                $section_cur++;
                $pos_row = $section_height * ( $section_cur - 1 );
            }

            my $indel_string = "$var->{indel_type}$var->{indel_length}";

            my $bg_idx = 'unknown';
            if ( $var->{indel_occured} ne 'unknown' ) {
                $bg_idx = oct( '0b' . $var->{indel_occured} ) % $color_loop;
            }

            for my $i ( 1 .. $seq_count ) {
                my $flag = 0;
                if ( $var->{indel_occured} eq "unknown" ) {
                    $flag = 1;
                }
                else {
                    my $occ = substr $var->{indel_occured}, $i - 1, 1;
                    if ( $occ eq '1' ) {
                        $flag = 1;
                    }
                }

                if ($flag) {
                    if ( $col_taken == 1 ) {

                        # write position
                        $sheet->write( $pos_row, $col_cursor, $var->{indel_start},
                            $format_of->{pos} );

                        # write in indel occured lineage
                        $sheet->write( $pos_row + $i,
                            $col_cursor, $indel_string, $format_of->{indel}{$bg_idx} );
                    }
                    elsif ( $col_taken == 2 ) {

                        # write indel_start position