plot-maf.pl

#=============================================================================
#     FileName: plot-maf.pl
#         Desc: A short script for using a maf tab file to draw a alignment block
#               graph.
#       Author: tanhao
#        Email: tanhao2013@gmail.com
#     HomePage: http://buttonwood.github.io
#      Version: 0.0.1
#   LastChange: 2014-04-21 15:31:28
#      History:
#=============================================================================

use Data::Dumper;
use SVG;

die("perl $0 lastz.tab >out.svg \n")unless(@ARGV==1);

open(IN,"<$ARGV[0]");
my %tar;
my %que;
my %hash;

while(<IN>){
	next if (/#/);
	next if (/^$/);
    my @t = split;
    $tar{$t[0]} = $t[5];
    $que{$t[6]} = $t[11];
    push @{$hash{$t[0]}{$t[6]}}, [$t[2],$t[5],$t[8],$t[9],$t[5],$t[11],$t[10]];
}
close IN;

#print Dumper(\%hash);

my $width  = 900;
my $height = 500;
my $reg    = 3.5;

#my $svg= SVG->new(width=>500,height=>400);
my $svg = SVG->new('width', ($width+100), 'height', ($height+100));

my @t = values %que;
#print Dumper(\@t);
#print Dumper(\%tar);
#print Dumper(\%que);

my @col_tab = ("deepskyblue","aqua","bisque","blueviolet","gold",
              "green","greenyellow","hkaki","orangered","olive",
              "orange","mediumblue","palegreen","deeppink");
my $len = &sum(\@t) + 10000;
my $blank = $#t + 5;
my $scale =  (($width + 100) - ($blank * $reg ))/$len;

my $idx = 0;
my $tmp  = 50;
foreach (sort{$tar{$b} <=> $tar{$a}} (keys %tar)){
    my $y = $tar{$_} * $scale;
    $tar{$_} = [$tmp,$y];
    $svg->rect(x => $tmp, y => 200, width => $y, height => 10,
            rx => 2.5, ry => 2.5, style => "fill:deepskyblue");
    $tmp += $y + $reg;
    $idx++;
}

$tmp = 10;
foreach (sort{$que{$b} <=> $que{$a}} (keys %que)){
	my $y = $que{$_} * $scale;
	$que{$_} = [$tmp,$y];
    my $col = $col_tab[$idx];
    $idx++;
    $svg->rect(x => $tmp, y => 350, width => $y, height => 10,
            rx => 2.5, ry => 2.5, style => "fill:$col");
    $tmp += $y + $reg;
}

foreach my $t (keys %hash) {
    my $tx = $tar{$t}->[0];
    my $ty = $tar{$t}->[1];
    foreach my $q (keys %{$hash{$t}}) {
        my $qx = $que{$q}->[0];
        my $qy = $que{$q}->[1];
        #my $tg = $hash{$t}{$q};
        #print Dumper($tg);
        foreach my $tg (@{$hash{$t}{$q}}) {
            #print Dumper($tg);
            my $ts = $tg->[0];
            my $te = $tg->[1];
            my $qs = $tg->[2];
            my $qe = $tg->[3];
            my $tl = $tg->[4];
            #print $tl,"\n";
            my $ql = $tg->[5];
            my $sd = $tg->[6]; # strand;
            my $style = "";
            if ($sd eq "+"){
                $style = "stroke:rgb(70,130,180)"; # SteelBlue
            }else{
                $style = "stroke:rgb(255,20,147)"; # pink
            }

            $svg->line(x1 => $tx + ($ts/$tl) * $ty,
                        y1 => 210,
                        x2 => $qx + ($qs/$ql) * $qy,
                        y2 => 350,
                        "stroke-width" => 2,
                        style =>$style
                        );
            $svg->line(x1 => $tx + ($te/$tl) * $ty,
                        y1 => 210,
                        x2 => $qx + ($qe/$ql) * $qy,
                        y2 => 350,
                        "stroke-width" => 2,
                        style =>$style
                        #style =>"stroke:rgb(255,20,147)"
                        );
        }
    }
}


print  $svg->xmlify;

sub sum{
    my $a = shift;
    #print Dumper($a);
    my $s = 0;
    foreach (@$a){
        $s += $_;
    }
    return $s;
}

# ============== Float like a butterfly! Stand like a buttonwood! ==============

stat.pl

#=============================================================================
#     FileName: stat.pl
#         Desc: A short script for alignment statistics with non-overlap blocks.
#       Author: tanhao
#        Email: tanhao2013@gmail.com
#     HomePage: http://buttonwood.github.io
#      Version: 0.0.1
#   LastChange: 2014-04-22 08:44:16
#      History:
#=============================================================================

use Data::Dumper;

die("Usage:\n\tperl $0 aln.tab tar|que start end\n
Examples:\n\tperl $0 blast.tab 1 3 4
\n\tperl $0 lastz.tab 7 9 10\n
")unless(@ARGV==4);

my %hash;
my $ic = $ARGV[1] - 1 || 0;
my $sc = $ARGV[2] - 1 || 2;
my $ec = $ARGV[3] - 1 || 3;

open(IN,"<$ARGV[0]");

while (<IN>) {
	next if /#/;
	next if /^$/;
	my @t = split;
	push @{$hash{$t[$ic]}{$t[$sc]}}, $t[$ec];
}
close IN;

#print Dumper(\%hash);

#&stat(\%hash);
my $all = 0;
foreach my $sid (keys %hash) {
	#print Dumper($hash{$sid});
	$all += &stat($hash{$sid},$sid);
}
print "All:\t", $all, "\n";

sub stat{
	my $rh = shift;
	my $tg = shift;
	#print Dumper($rh);
	my $s = 0;
	my $m = 0;
	my $n = 0;
	my @rk = sort {$a <=> $b} (keys %$rh);
	#print Dumper(\@rk);
	foreach my $x (@rk) {
		my $ra = $rh->{$x};
		my $y = $ra->[0];

		if ($#$ra > 0) {
			my @ra_rsorted = sort{$b <=> $a} (@$ra);
			$y  = $ra_rsorted[0];
		}

		#print $m, "\t", $n, "\t", $x, "\t", $y, "\t";# "\n";
		print $tg, "\t", $m, "\t", $n, "\t", $x, "\t", $y, "\t";# "\n";
		if ($m <= $x) {
		 	if ($n < $x) { # m,n,x,y
		 		$s += $y - $x;
		 		print $s, "\tG\n";
		 		$m  = $x; $n = $y;
		 	}else{
		 		if($n < $y){ # m,x,n,y
		 			$s += $y - $n;
		 			print $s, "\tG\n";
		 			$m  = $n; $n  = $y;
		 		}else{  # m,x,y,n
		 			print $s, "\tB\n";
		 			next;
		 		}
		 	}
		 }else{
		 	print $s, "\tB\n";
		 	#print $m, "\t", $n, "\t", $x, "\t", $y, "\n";
		 }
	}
	return $s;
	#print "All\t", $s, "\n";
}

# ============== Float like a butterfly! Stand like a buttonwood! ==============