#!/usr/bin/perl -w
#
# TILLING_parse.pl
#
# Script to parse Maq pileup file from alignment of
# munged barcoded Illumina reads from EMS population vs munged refseqs.
# Needs pileup -v because we're going to record the base qualities
#
# See also scripts "mung_barcoded_reads.pl" and "mung_refs.pl"
#
# Martin.Trick@bbsrc.ac.uk, 1/9/2009
#
# Re-tooled for BAT TILLING 2 experiment, no correspondence required
# between dimensions of hyperpooling
# Martin.Trick@bbsrc.ac.uk, 31/3/2011
#
# We are going to look at EMS candidates:  G->A / C->T substitutions
#
# Tweaked code to only report on EMS-mutable bases within the target
# window (i.e. between  munged barcode+M13+SP and RP+munged barcode)
# Introduce RPM statistic to assess barcode/target efficiency
# Martin.Trick@jic.ac.uk, 24/7/2012
# ===================================================================

use FileHandle;
STDOUT->autoflush(1);

unless (@ARGV == 3) {
  print "Usage: TILLING_parse.pl <pileup file> <output file> <statistics file>\n";
  exit;
}

# Hash for mapped read frequencies
my %reads = ();
# Hash to hold all allele frequencies across targets and barcodes
my %data = ();
# Hash of arrays to store ref seqs;
my %ref = ();

# Offset coordinates of munged amplicons to coordinates relative to start M13
my $offset = 24;

my $readlength = 94; # munged length
my $quality_threshold = 20;
my $tags = 0;

# Definitions of windows for reporting on mutable bases
# $offset+len(SP) < k < len(ref) - ($offset + len(RP))
my %window = ('FAD2_1_C5' => {
			      'start' => '61',
			      'end' => '249',
			     },
	      'FAD2_2_A5' => {
			      'start' => '61',
			      'end' => '249',
			     },
	      'FAD2_4_A1' => {
			      'start' => '61',
			      'end' => '249',
			     },
	      'GL2b_C6' => {
			    'start' => '70',
			    'end' => '147',
			   },
	     );


print "Started at " . scalar localtime() . "\n";

open (PILEUP, "<$ARGV[0]") or die "Couldn't open Maq pileup file ($!)\n";
open (OUT, ">$ARGV[1]") or die "Couldn't open output file ($!)\n";
open (STATS, ">$ARGV[2]") or die "Couldn't open output file ($1)\n";

print "Reading in pileup file... ";
while (<PILEUP>) {
  #print "\rParsing line $.";
  @cols = ();
  @calls = ();
  %calls = ();
  @qualities = ();
  %qualities = ();
  @cols = split;
  ($barcode,$target) = $cols[0] =~ /(\w+)\-([\w\-]+)/;
  # Store the reference sequences
  push @{$ref{$target}}, $cols[2];
  # Record reads against barcode/target to assess composition of PCR population
  $reads{$barcode}{$target} +=  $cols[3];
  # Cumulative total alignment
  $tags += $cols[3];
  # Only consider target region and EMS candidates therein
  next unless (($cols[1]) >= $window{$target}{start})  && ($cols[1] <= $window{$target}{end});
  next unless (($cols[2] =~ /G/) or ($cols[2] =~ /C/));
  # Else parse the calls and qualities
  push @calls, split //, $cols[4];
  push @qualities, split //, $cols[5] if (defined $cols[5]);
  foreach my $q (1 .. $#qualities) { # Skips the '@'
    $qualities[$q] = ord($qualities[$q]) - 33;
  }
  unless (@calls == 0) {
    foreach my $call(1 .. $#calls) { # Skip leading '@' char
      $calls[$call] =~ s/[.,]/$cols[2]/;
      $calls[$call] =~ tr/acgtn/ACGTN/;
      $calls{$calls[$call]}++ if ($qualities[$call] > $quality_threshold);
    }
  }
  # Create allele frequency string array
  foreach $base('A','C','G','T') {
    if (!exists $calls{$base}) {
      $calls{$base} = 0;
    }
    $f = "$base\[" . $calls{$base} . "\]";
    push @{$data{$target}{$cols[1]}{$barcode}}, $f;
  }
}

print "done\n";
close PILEUP;


my $reads = ($tags/$readlength);

# Assemble statistics
foreach my $barcode(sort keys %reads) {
  print STATS "$barcode\t";
  foreach my $target(sort keys %{$reads{$barcode}}) {
    $rpm = $reads{$barcode}{$target}/$reads;
    print STATS "$rpm\t";
  }
  print STATS "\n";
}
close STATS;

# Analysis
foreach my $target (sort keys %data) {
  foreach my $pos (sort {$a <=> $b} keys %{$data{$target}}) {
    next if (($pos > ($readlength + $offset))) || ($pos < (scalar(@{$ref{$target}}) - ($readlength + $offset)));
    foreach my $barcode (sort keys %{$data{$target}{$pos}}) {
      # Assemble string from array for quick comparison
      $f_string = join '', @{$data{$target}{$pos}{$barcode}};
      if (($ref{$target}[$pos-1] eq 'G' && $f_string =~ /A\[\d+.*\]/) ||
	  ($ref{$target}[$pos-1] eq 'C' && $f_string =~ /T\[\d+.*\]/)) {
	print OUT "$barcode\t$target:" . ($pos - $offset) . "\t$ref{$target}[$pos-1]\t";
	foreach $f(0 .. $#{@{$data{$target}{$pos}{$barcode}}}) {
	  print OUT "$data{$target}{$pos}{$barcode}[$f]\t";
	}
	print OUT "\n";
      }
    }
  }
}

close OUT;

print "Finished at " . scalar localtime() . "\n";
