#!/usr/bin/env perl   

#  -*- perl -*-

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

# Ebbe Sloth Andersen, May 2006.

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

my ( $entries, $file, $header );

( $file ) = @ARGV;

( $header, $entries ) = &Formats::read_col ( $file );
#&Errors::check_col ( $entries, { "TYPE" => ["RNA","pairingmask"],
#                                 "COL"  => ["align_bp","certainty"] } );
#&Errors::check_col ( $entries, { "TYPE" => ["RNA","pairingmask"] } );
#print Dumper ( $entries );
#exit;
( $header, $entries ) = &consistency ( $entries );
$header .= "; consistency_color.pl was run on this file.";
&Formats::write_col ( $header, $entries );

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

sub consistency
{
    # Ebbe Sloth Andersen, April 2007.

    my ( $entries ) = @_;

    # Returns an array of hashes.

    my ( @entries1, @entries2, @entries3, @entries4,
         $file1, $file2, $file3, $file4,
         @print, $line, $header, $now, $entry, 
         @common, $common, 
         $i, $j,
         @score, @residue, $score, $residue,
         $r, $g, $b,
         @r, @g, @b,
         @certainty,
         @group,
         $align_bp,
         @rfam,
         @cert,
         $position,
         $Sto, $Sto2, $St, $St2,
         $Sov, $Sov2, $So, $So2,
         $Sin, $Sin2, $Si, $Si2,
         $Sno, $Sno2, $Sn, $Sn2,
         @mask,
         @align_bp,
         $N,
         @SS,
         $length,
        );
    
    $i = 1;

    foreach $entry ( @{ $entries } ) {
        if ( $entry->{ENTRY} eq "SS_cons" ) { $entry->{TYPE} = "pairingmask"; }
    }

# compare rfam with each pcluster group
    @SS = grep { $_->{'TYPE'} eq "pairingmask" } @{ $entries };
    @rfam = split ( /,/, $SS[0]->{align_bp} );



# remove pairings that points outside 

    $length = scalar @rfam;

    $i = 0;
    foreach $entry ( @rfam ) {
        if ( $entry ne "." ) {
            if ( $entry > $length ) {
                $entry = ".";
            }
        }
        $mask[$i] = "-";
        $i++;
    }

$i = 0;
$Sin = 0;
$Sno = 0;
$Sov = 0;
$Sto = 0;
$Si = 0;
$Sn = 0;
$So = 0;
$St = 0;
$Si2 = 0;
$Sn2 = 0;
$So2 = 0;
$St2 = 0;
$Sin2 = 0;
$Sno2 = 0;
$Sov2 = 0;
$Sto2 = 0;
$N = 0;
foreach $entry ( @{ $entries } ) {
    if ( $entry->{TYPE} eq "arbitrary" ) {
        @residue = ( );
        @residue = split ( /,/, $entry->{residue} );
        @group = ( );
        @group = split ( /,/, $entry->{align_bp} );
        foreach $residue ( @residue ) {
            $entry->{color_r} .= "1.00,";
            $entry->{color_g} .= "1.00,";
            $entry->{color_b} .= "1.00,";
        }
    }

     if ( $entry->{TYPE} eq "RNA" ) {
        $N++;
        $Sin = 0;
        $Sno = 0;
        $Sov = 0;
        $Sto = 0;
        $Si = 0;
        $Sn = 0;
        $So = 0;
        $St = 0;
        @cert = ( );
        @cert = split ( /,/, $entry->{certainty} );
        @residue = ( );
        @residue = split ( /,/, $entry->{residue} );

     	$entry->{color_r} = "";
        $entry->{color_g} = "";
        $entry->{color_b} = "";

        # compare
        $i = 0;
        foreach $align_bp ( @group ) {
            $r = 1.00; $g = 1.00; $b = 1.00; 
            if ( $align_bp ne "." ) {                                                                     # prediction has base pair
                $Sto = $Sto + $cert[$i];
                $St++;
                if ( $rfam[$i] ne "." ) {                                                                      # rfam has base pair
                    if ( $align_bp == $rfam[$i] ) {                                                            # same base pair
                        $Sov = $Sov + $cert[$i];
                        $So++;
                        $r = 0.90; $g = 1.00; $b = 0.90;                                                   
                        if ( $cert[$i] > 0.80 ) { $r = 0.70; $g = 1.00; $b = 0.70; }
                        if ( $cert[$i] > 0.90 ) { $r = 0.50; $g = 1.00; $b = 0.50; }
                        if ( $mask[$i] ne "*" ) { $mask[$i] = "g"; }
                    } else {                                                                                             # not same base pair
                        $Sin = $Sin + $cert[$i];
                        $Si++;
                        $r = 1.00; $g = 0.90; $b = 0.90;                                                   
                        if ( $cert[$i] > 0.80 ) { $r = 1.00; $g = 0.70; $b = 0.70; }
                        if ( $cert[$i] > 0.90 ) { $r = 1.00; $g = 0.50; $b = 0.50; }
                        $mask[$i] = "*";
                        $mask[$rfam[$i]-1] = "*";
                    }
                } else {                                                                                           # rfam does not have base pair
                    if ( $rfam[$align_bp-1] ne "." ) {                                                         # red = not same base pair
                        $Sin = $Sin + $cert[$i];
                        $Si++;
                        $r = 1.00; $g = 0.90; $b = 0.90;                                              
                        if ( $cert[$i] > 0.80 ) { $r = 1.00; $g = 0.70; $b = 0.70; }
                        if ( $cert[$i] > 0.90 ) { $r = 1.00; $g = 0.50; $b = 0.50; }
                        $mask[$i] = "*";
                    } else {                      
                        $Sno = $Sno + $cert[$i];
                        $Sn++;
                        $r = 1.00; $g = 1.00; $b = 0.90;                                              # yellow = consistent insert
                        if ( $cert[$i] > 0.80 ) { $r = 1.00; $g = 1.00; $b = 0.70; }
                        if ( $cert[$i] > 0.90 ) { $r = 1.00; $g = 1.00; $b = 0.50; }
                        if ( $mask[$i] eq "-" ) { $mask[$i] = "o" }; 
                    } 
                }
                if ( $residue[$i] =~ /-/ ) { $r = 1.00; $g = 1.00; $b = 1.00; }
                if ( $residue[$i] =~ /a/ ) { $r = 1.00; $g = 1.00; $b = 1.00; }
                if ( $residue[$i] =~ /c/ ) { $r = 1.00; $g = 1.00; $b = 1.00; }
                if ( $residue[$i] =~ /g/ ) { $r = 1.00; $g = 1.00; $b = 1.00; }
                if ( $residue[$i] =~ /u/ ) { $r = 1.00; $g = 1.00; $b = 1.00; }
            } else {                                                                                           # prediction is single stranded
                if ( $residue[$i] =~ /-/ ) {
                    $r = 1.00; $g = 1.00; $b = 1.00;                                               # white = nothing to compare 
                } else {
                    $r = 0.90; $g = 0.90; $b = 0.90;                                               # grey = single stranded      
                    if ( $cert[$i] > 0.80 ) { $r = 0.80; $g = 0.80; $b = 0.80; }
                    if ( $cert[$i] > 0.90 ) { $r = 0.70; $g = 0.70; $b = 0.70; }
                }
                if ( $rfam[$i] ne "." ) {
                        if ( $mask[$i] eq "-" ) { $mask[$i] = "o" }; 
                }
            }
            $entry->{color_r} .= "$r,";
            $entry->{color_g} .= "$g,";
            $entry->{color_b} .= "$b,";
            $i++;
        }
        $Sin2 = $Sin2 + $Sin;
        $Si2 = $Si2 + $Si;
        $Sov2 = $Sov2 + $Sov;
        $So2 = $So2 + $So;
        $Sno2 = $Sno2 + $Sno;
        $Sn2 = $Sn2 + $Sn;
        $Sto2 = $Sto2 + $Sto;   
        $St2 = $St2 + $St;   
    }
}

# color rfam mask
$SS[0]->{color_r} = "";
$SS[0]->{color_g} = "";
$SS[0]->{color_b} = "";
$i = 0;
foreach $entry ( @mask ) {
    if ( $rfam[$i] ne "." ) {
        if ( $entry eq "*" ) {
            $mask[$rfam[$i]-1] = "*";
        }
    }
    $i++;
}
$i = 0;
foreach $entry ( @mask ) {
    if ( $rfam[$i] ne "." ) {
        if ( $entry eq "*" ) {
            $SS[0]->{color_r} .= "1.00,"; # red
            $SS[0]->{color_g} .= "0.00,";
            $SS[0]->{color_b} .= "0.00,";
        } elsif ( $entry eq "o" ) {
            $SS[0]->{color_r} .= "1.00,"; # yellow
            $SS[0]->{color_g} .= "1.00,";
            $SS[0]->{color_b} .= "0.00,";
        } elsif ( $entry eq "g" ) { 
            $SS[0]->{color_r} .= "0.00,"; # green
            $SS[0]->{color_g} .= "1.00,";
            $SS[0]->{color_b} .= "0.00,";
        } else {
            $SS[0]->{color_r} .= "1.00,"; # white
            $SS[0]->{color_g} .= "1.00,";
            $SS[0]->{color_b} .= "1.00,";
        }
    } else {
        $SS[0]->{color_r} .= "1.00,"; # white
        $SS[0]->{color_g} .= "1.00,";
        $SS[0]->{color_b} .= "1.00,";
    }
    $i++;
}

    if ( $Sto2 != 0 ) {
        $So = $Sov2 / $Sto2 * 100;
        $Si = $Sin2 / $Sto2 * 100;
        $Sn = $Sno2 / $Sto2 * 100;
    }
    $header = "Comparison of the structure assignment of Pcluster to Rfam gives:\n";
    $header .= "; Sto = $Sto2\n";
    $header .= "; Sco = $Sov2\t$So%\n";
    $header .= "; Sin = $Sin2\t$Si%\n";
    $header .= "; Sno = $Sno2\t$Sn%\n";
    
    return ( $header, $entries );
}
