root/bin/iprscan2gff3

#! /usr/bin/perl -w

use strict;
use URI::Escape;

my $file = shift;
my $gff3 = shift;

my %index;
my %list;
my %GO;

open(IN, "< $file");
while(defined(my $line = <IN>)){
    chomp $line;
    my @F = split("\t", $line);
    
    if($index{$F[0]}{$F[11]}){
        my $ok = 0;
        F1: foreach my $grp (@{$index{$F[0]}{$F[11]}}){
           F2: foreach my $m (@$grp){
               if(overlap($m->[0], $m->[1], $F[6], $F[7]) > 0.5){
                   #add new member
                   $ok = 1;
                   push(@$grp, [$F[6], $F[7]]);
                   last F1;
               }
           }
        }

        #make new group
        push(@{$index{$F[0]}{$F[11]}}, [[$F[6], $F[7]]]) if(! $ok);
    }
    else{
        #make new group
        push(@{$index{$F[0]}{$F[11]}}, [[$F[6], $F[7]]]);
    }

    my @go = $line =~ /(GO\:\d+)/;

    $F[12] =~ s/\t/ /g;
    $F[12] = uri_escape($F[12], '\,\;\=\%\&');
    $list{$F[11]} = $F[12];
    $GO{$F[11]} = join(",", @go);
}
close(IN);

#colapse groups
while(my $t = each %index){
    while(my $d = each %{$index{$t}}){
        foreach my $grp (@{$index{$t}{$d}}){
            my $B;
            my $E;
            foreach my $m (@$grp){
                $B = $m->[0] if(!$B || $m->[0] < $B);
                $E = $m->[1] if(!$E || $m->[1] > $E);
            }
            $grp = [$B, $E];
        }
    }
}

while(my $t = each %index){
    while(my $d = each %{$index{$t}}){
        my $array = $index{$t}{$d};
        my @keepers;
        for(my $i = 0; $i < @$array; $i++){
            my $grp1 = $array->[$i];
            next if(! $grp1);
            my $B = $grp1->[0];
            my $E = $grp1->[1];
            for(my $j = $i+1; $j < @$array; $j++){
                my $grp2 = $array->[$j];
                next if(! $grp2);
                if(overlap($grp1->[0], $grp1->[1], $grp2->[0], $grp2->[1]) > 0.5){
                    $B = $grp2->[0] if($grp2->[0] < $B);
                    $E = $grp2->[1] if($grp2->[1] > $E);
                    
                    $array->[$j] = undef;
                }
            }
            push(@keepers, [$B, $E])
        }
        $index{$t}{$d} = \@keepers;
    }
}

#parse gff3
my %details;
my %mRNAs;
open(IN, "< $gff3");
while(defined(my $line = <IN>)){
    last if($line =~ /\#\#FASTA/);
    next if($line =~ /^\#/);
    next unless($line =~ /\tCDS\t/);

    chomp $line;
    my @F = split("\t", $line);
    if($F[2] eq 'CDS'){
        my ($parent) = $F[8] =~ /Parent\=([^\;\n]+)/;
        push(@{$mRNAs{$parent}}, [$F[3], $F[4]]);
        $details{$parent}{seqid} = $F[0];
        $details{$parent}{strand} = $F[6];
    }
}
close(IN);

#sort CDSs
while(my $key = each %mRNAs){
    @{$mRNAs{$key}} = sort {$a->[0] <=> $b->[0]} @{$mRNAs{$key}};
}

#make gff3 lines
my $id = 0;
while(my $t = each %index){
    my $CDSs = $mRNAs{$t};
    while(my $d = each %{$index{$t}}){
        my $set = $index{$t}{$d};

        foreach my $hit (@$set){
            my @match;

            my $leader = 0;
            my $started = 0;
            foreach my $CDS (@$CDSs){
                my $offset = $CDS->[0] - 1;

                my $B = $hit->[0] + $offset - $leader;
                my $E = $hit->[1] + $offset - $leader;

                my $cB = $CDS->[0];
                my $cE = $CDS->[1];

                if($cB <= $B &&  $B <= $cE && $cB <= $E &&  $E <= $cE){
                    push(@match, [$B, $E, $offset - $leader]);
                    last;
                }
                elsif($cB <= $B &&  $B <= $cE){
                    push(@match, [$B, $cE, $offset - $leader]);
                    $started = 1;
                }
                elsif($cB <= $E &&  $E <= $cE){
                    push(@match, [$cB, $E, $offset - $leader]);
                    last;
                }
                elsif($started){
                    push(@match, [$cB, $cE, $offset - $leader]);
                }

                $leader += abs($cE - $cB) + 1;
            }

            @match = sort {$a->[0] <=> $b->[0]} @match;

            #match begin and end in gff3
            my $mB = $match[0]->[0];
            my $mE = $match[-1]->[1];
            
            #target begin and end in attributes
            my $tB = $mB - $match[0]->[2];
            my $tE = $mE - $match[-1]->[2];

            #gff3 colums
            my $seqid = $details{$t}{seqid};
            my $source = 'iprscan';
            my $type = 'match';
            my $start = $mB;
            my $end = $mE;
            my $score = '.';
            my $strand = $details{$t}{strand};
            my $phase = '.';
            my $p_id = "match:".$id++;
            my $attributes = "Name=$d $list{$d}\;ID=$p_id\;Target=$d $tB $tE +\;";
            $attributes .= "Ontology_term=$GO{$d}\;" if($GO{$d});

            print "$seqid\t$source\t$type\t$start\t$end\t$score\t$strand\t$phase\t$attributes\n";

            foreach my $p (@match){
                my $pB = $p->[0];
                my $pE = $p->[1];
                my $off = $p->[2];

                #set nesessary values
                $type = 'match_part';
                $start = $pB;
                $end = $pE;
                $attributes = "Name=$d:match_part:$id\;ID=match_part:".$id++."\;";
                $attributes .= "Parent=$p_id\;Target=$d ".($pB - $off)." ".($pE - $off)." +\;";

                print "$seqid\t$source\t$type\t$start\t$end\t$score\t$strand\t$phase\t$attributes\n";
            }
        }
    }
}

#----------------SUBS--------------------------
sub overlap {
    my $aB = shift;
    my $aE = shift;
    my $bB = shift;
    my $bE = shift;

    my @seq;
    
    for(my $i = $aB; $i <= $aE; $i++){
        $seq[$i]++;
    }

    for(my $i = $bB; $i <= $bE; $i++){
        $seq[$i]++;
    }

    my $count = 0;
    foreach my $c (@seq[$aB..$aE]){
        $count++ if($c == 2);
    }
    my $over1 = $count / ($aE - $aB + 1);

    $count = 0;
    foreach my $c (@seq[$bB..$bE]){
        $count++ if($c == 2);
    }
    my $over2 = $count / ($bE - $bB + 1);

    return ($over1 > $over2) ? $over1: $over2;
}