#!/usr/bin/env perl   

#  -*- perl -*-

use strict;
use warnings FATAL => qw ( all );
use Data::Dumper;
use Formats;
use Errors;

# REASSEMBLE
#
# reassemble result.col input.col 1-10,40-50 > result2.col
#
# Ebbe Sloth Andersen, Dec 2005.

# >>>>>>>>>>>>>>>>>> RUN PROGRAM <<<<<<<<<<<<<<<<<<<<

my ( $entries, $entries1, $entries2, $file1, $file2, $header, $regions );

( $file1, $file2, $regions ) = @ARGV;
$entries1 = &Formats::read_col ( $file1 );
$entries2 = &Formats::read_col ( $file2 );
#&Errors::check_col ( $entries1, { "TYPE" => ["RNA","pairingmask"],
#						         "COL"  => ["certainty","align_bp"] } );
#&Errors::check_col ( $entries2, { "TYPE" => ["RNA","pairingmask"],
#						         "COL"  => ["certainty","align_bp"] } );
if ( defined $regions ) {
    $entries = &reassemble ( $entries1, $entries2, $regions );
} else {
    $entries = $entries1;
}
$header .= "This file was made by reassemble";
&Formats::write_col ( $header, $entries );

# >>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<

sub reassemble
{
    my ( $entries1, $entries2, $regions ) = @_;
    
    my ( $entry,
		$f1,
		$t1,
		$f2,
		$t2,
         @residue,
         @residue1,
         @residue2,
         @pairingmask,
         $i,
         $s,
         @result,
         @prime5,
         @middle,
         @prime3,
         @ligate,
         $residue1,
         $residuex,
         $residuey,
         $prime5,
         @x,
         @catch,
         $ENTRY,
         $TYPE,
         $end,
         $p5,
         $p3,
         $middle,
         $pos,
         $length,
         $residue,
         $pairingmask,
         @certainty,
         $certainty,
         @align_bp,
         $align_bp,
         $alignpos,
         $label,
         $label2,
         $seqpos,
         $pm,
         $prev,
         $count,
         );

if ( defined $regions ) {
    if ( $regions =~ /(\d+)\-(\d+)\,(\d+)\-(\d+)/ ) {
        $f1 = $1;
        $t1 = $2;
        $f2 = $3;
        $t2 = $4;
    } elsif ( $regions =~ /^(\d+)\-(\d+)$/ ) {
        $f1 = 0;
        $t1 = 0;
        $f2 = $1;
        $t2 = $2;
    }
}

    # prepare
    $pm = 0;
    $prev = 5;
    $count = 0;
    foreach $entry ( @{ $entries1 } ) {
        
        # result file
        $TYPE = $entry->{'TYPE'};
        $ENTRY = $entry->{'ENTRY'};


        if ( $TYPE eq "pairingmask" ) {
            @pairingmask = ( );
            @pairingmask = split ( /,/, $entry->{'residue'} );
            $pm = $count;
        } else {
            # result file data
            @residue = ( );
            @residue = split ( /,/, $entry->{'residue'} );      
            @certainty = split ( /,/, $entry->{'certainty'} );  
            @align_bp = split ( /,/, $entry->{'align_bp'} );    
           
            # find the same entry in input file
            @catch = grep { $_->{'ENTRY'} eq "$ENTRY" } @{ $entries2 }; 
            @residue2 = split ( /,/, $catch[0]->{'residue'} );  

            # retrieve missing parts from input file
            $end = scalar @residue2;
            @x = @residue2;
            @prime5 = splice @x, 0, $f1-1;
            @x = @residue2;
            @middle = splice @x, $t1, $f2-$t1-1;
            @x = @residue2;
            @prime3 = splice @x, $t2, $end-$t2;
            
            if ( $f1 == 0 && $t1 == 0 ) { @prime5 = ( ) };
            
            # splice them together
            splice @residue, 0, 0, @prime5;
            splice @residue, $t1, 0, @middle;
            splice @residue, $t2, 0, @prime3;

            splice @pairingmask, 0, 0, @prime5;
            splice @pairingmask, $t1, 0, @middle;
            splice @pairingmask, $t2, 0, @prime3;

            splice @certainty, 0, 0, @prime5;
            splice @certainty, $t1, 0, @middle;
            splice @certainty, $t2, 0, @prime3;

            splice @align_bp, 0, 0, @prime5;
            splice @align_bp, $t1, 0, @middle;
            splice @align_bp, $t2, 0, @prime3;

            # modify
            $i = 0;
            foreach $certainty ( @certainty ) {
                if ( $certainty =~ /^\D/ ) { 
                    $certainty[$i] = 0.0000;
                    $align_bp[$i] = ".";
                    $pairingmask[$i] = ".";
                }
                $i++;
            }

            # join them
            $residue = join ( ',', @residue );
            $certainty = join ( ',', @certainty );
            $pairingmask = join ( ',', @pairingmask );
            $align_bp = join ( ',', @align_bp );

            # regenerate standard columns            
            $i = 1;
            $s = 1;
            $seqpos = "";
            $alignpos = "";
            $label = "";
            foreach $residue ( @residue ) {
                if ( $residue eq "-" ) { 
                    $seqpos .= ".,"; 
                    $label .= "G,"; 
                } else {
                    $seqpos .= "$s,";
                    $label .= "N,"; 
                    $s++;
                } 
                $alignpos .= "$i,";
                $label2 .= "M,";
                $i++;
            }            

            # print the extended sequence into result file
            $entry->{'residue'} = $residue;
            $entry->{'certainty'} = $certainty;
            $entry->{'align_bp'} = $align_bp;
            $entry->{'alignpos'} = $alignpos;
            $entry->{'seqpos'} = $seqpos;
            $entry->{'label'} = $label;

            if ( $pm ne $prev ) {
                $entries1->[$pm]->{'residue'} = $pairingmask;
                $entries1->[$pm]->{'certainty'} = $certainty;
                $entries1->[$pm]->{'alignpos'} = $alignpos;
                $entries1->[$pm]->{'label'} = $label2;
                $entries1->[$pm]->{'align_bp'} = $align_bp;
            }
            $prev = $pm;
        }
        $count++;
    }
    return $entries1;
}

