#!/usr/bin/perl

# Copyright (c) 2017 Michael Roach (Australian Wine Research Institute)
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use strict;
use warnings;
use Getopt::Long;
use threads;
use Thread::Semaphore;
use Thread::Queue;
use FindBin qw($RealBin);
use List::Util qw/sum/;
use lib "$RealBin/../lib";
use PipeUtils;


#---INPUT PARAMETERS---

my $genome;
my $coverage_stats;
my $bam_file;
my $threads = 4;
my $limit_io;
my $maxmatch_cutoff = 250;
my $bestmatch_cutoff = 70;
my $low_cutoff = 40;
my $hit_cutoff = 20;
my $out_prefix = 'curated';
my $dotplots;
my $repeats;
my $min_win_size = 5000;
my $max_windows = 200;
my $minimap2_parameters = '-p 0';
my $minimiser_drop = '4G';
our $verbose;


#---HELP MESSAGE---

my $usage = "
USAGE:
purge_haplotigs  purge  -g genome.fasta  -c coverage_stats.csv

REQUIRED:
-g / -genome        Genome assembly in fasta format. Needs to be indexed with samtools faidx.
-c / -coverage      Contig by contig coverage stats csv file from the previous step.

OPTIONAL:
-t / -threads       Number of worker threads to use. DEFAULT = $threads
-o / -outprefix     Prefix for the curated assembly. DEFAULT = \"$out_prefix\"
-r / -repeats       BED-format file of repeats to ignore during analysis.
-d / -dotplots      Generate dotplots for manual inspection.
-b / -bam           Samtools-indexed bam file of aligned and sorted reads/subreads to the
                    reference, required for generating dotplots.

ADVANCED:
-a / -align_cov     Percent cutoff for identifying a contig as a haplotig. DEFAULT = $bestmatch_cutoff
-m / -max_match     Percent cutoff for identifying repetitive contigs. Ignored when 
                    using repeat annotations (-repeats). DEFAULT = $maxmatch_cutoff
-I                  Minimap2 indexing, drop minimisers every N bases, DEFAULT = $minimiser_drop
-v / -verbose       Print EVERYTHING.
-limit_io           Limit for I/O intensive jobs. DEFAULT = -threads
-wind_min           Min window size for BED coverage plots (for dotplots). DEFAULT = $min_win_size
-wind_nmax          Max windows per contig for BED coverage plots (for dotplots). DEFAULT = $max_windows

";


#---CHECK PROGRAMS---

if (!(check_programs qw/bash bedtools minimap2 samtools/)){
    err('ONE OR MORE REQUIRED PROGRAMS IS MISSING');
}



#---PARSE ARGUMENTS---

my $args = "@ARGV";
GetOptions (
    "genome=s" => \$genome,
    "coverage_stats=s" => \$coverage_stats,
    "bam=s" => \$bam_file,
    "threads=i" => \$threads,
    "limit_io=i" => \$limit_io,
    "outprefix=s" => \$out_prefix,
    "align_cov=i" => \$bestmatch_cutoff,
    "max_match=i" => \$maxmatch_cutoff,
    "I=s" => \$minimiser_drop,
    "dotplots" => \$dotplots,
    "repeats=s" => \$repeats,
    "wind_min=i" => \$min_win_size,
    "wind_nmax=i" => \$max_windows,
    "verbose" => \$verbose
) or die $usage;

# required parameters
(($genome) && ($coverage_stats)) or die $usage;
($limit_io) or $limit_io = $threads;


# require bam file if generating dotplots
if ($dotplots){
    ($bam_file) or die $usage;
    if (!(check_programs qw/Rscript/)){
        err('ONE OR MORE REQUIRED PROGRAMS IS MISSING');
    }
}

# check the files
if (!(check_files($genome, $coverage_stats))){
    msg('One or more files missing, exiting');
    die $usage;
}

# check optional files
if (($repeats) && !(check_files($repeats))){
    msg('One or more files missing, exiting');
    die $usage;
}
if (($dotplots) && !(check_files($bam_file))){
    msg('One or more files missing, exiting');
    die $usage;
}


#---SET UP LOGGING---
our $LOG;
my $TMP_DIR = 'tmp_purge_haplotigs';
(-d $TMP_DIR) or mkdir $TMP_DIR;
open $LOG, '>', "$TMP_DIR/purge_haplotigs_purge.log" or die "failed to open log file for writing";



#---GLOBAL VARIABLES---

# directories
my $MINCE_DIR = "$TMP_DIR/CONTIGS";
my $TMP_ALN = "$TMP_DIR/TMP_ALN";
my $COV_DIR = "$TMP_DIR/COV";
my $ERR_DIR = "$TMP_DIR/STDERR";
my $ASSIGNED = 'dotplots_reassigned_contigs';
my $UNASSIGNED = 'dotplots_unassigned_contigs';
my $PTH;

# files
my $assembly_fasta = "$TMP_DIR/assembly.fasta";
my $assembly_index = "$TMP_DIR/assembly.$minimiser_drop.mmi";
my $suspects_fasta = "$TMP_DIR/suspects.fasta";
my $minimap2PAF = "$TMP_DIR/minimap2.$minimiser_drop.paf";
my $minimap2IDX = "$minimap2PAF.index";
my $hit_summary = "$TMP_DIR/hit_summary.tsv";
my $assembly_repeats = "$TMP_DIR/assembly.repeats.bed";
my %mmIndex;                    # $mmIndex{contig} = file read start (bytes)


# some clean file names
my $genome_file_name = $genome;
$genome_file_name =~ s/.*\///;


# reassignment step
my %suspects;   # suspects flagged from coverage analysis
my %junk;       # junk flagged from coverage analysis

my %contigLEN :shared;          # length of contig
my %contigMLEN :shared;         # length minus repetitive regions
my %contigFAI :shared;          # key = cleaned contig name, value = .fasta.fai line
my %contigHIT1 :shared;         # first best remaining hit
my %contigHIT2 :shared;         # second best remaining hit
my %contigBM :shared;           # best match score (percent contig aligned to either hit)
my %contigMM :shared;           # max match score (sum of all alignments as perc of contig)
my %contigASSIGN :shared;       # contig reassignment, r=repeat, h=haplotig, n=no reassign, u=unknown
my %contigREASSIGN :shared;     # 1/0, flag if it's been reassinged
my %contigSUFFIX :shared;       # fasta description for reassigned contigs
my %contigOVPURG :shared;       # flag, contig is over-purged
my %hits :shared;               # hash of annonymous array refs of contig hits
my $over_purge_mode;            # for over-purge checking, mode will either be 'detect' or 'fix'


# contig association step:
my %primaries;
my %refs;
my @current_path;
my @current_path_rename;
my $current_depth;



#---OUTPUT FILES---

my $contig_paths = "$out_prefix.contig_associations.log";
my $out_fasta = "$out_prefix.fasta";
my $out_haplotigs = "$out_prefix.haplotigs.fasta";
my $out_artefacts = "$out_prefix.artefacts.fasta";
my $out_reassignments = "$out_prefix.reassignments.tsv";



#---THREADS---

my $available_threads = Thread::Semaphore->new($threads);
my $max_jobs = Thread::Semaphore->new($limit_io);
my $writing_to_out = Thread::Semaphore->new(1);
my $queueBedtools = Thread::Queue->new();
my $queueHitSummary = Thread::Queue->new();
my $queuePairwise;
my $queueOverPurge;


#---OPEN DIRS ETC---

pre_flight();



#---PRINT PARAMETERS---
my $param_message = "
Beginning Pipeline

PARAMETERS:
Genome fasta:           $genome
Coverage csv:           $coverage_stats";
if ($bam_file){
    $param_message .= "
Produce dotplots:       TRUE
Bam file:               $bam_file
Min cov window len:     $min_win_size bp
max ctg cov windows:    $max_windows";
} else {
    $param_message .= "
Produce dotplots:       FALSE";
}
if ($repeats){
    $param_message .= "
Repeat annotations:     $repeats";
}
$param_message .= "
Threads:                $threads
I/O intense jobs:       $limit_io
Cutoff, alignment:      $bestmatch_cutoff %
Cutoff, repeat:         $maxmatch_cutoff %
Cutoff, suspect:        $low_cutoff %
Out prefix:             $out_prefix
minimap2 parameters:    '$minimap2_parameters'

Running using command:
purge_haplotigs purge $args\n\n";

msg($param_message);


#---PIPELINE BEGIN---

msg("\n\n###\n\nPREPARATION\n\n###\n");

# read in fasta.fai
read_fasta_fai();

# read in coverage stats
read_cov_stats();

# mince genome, this will make later steps run much faster
unconcatenate_genome();

# make bed windows, reads per window, for each contig. Used later for juxtaposing read-depth coverage with dotplots
get_window_coverage() if ($dotplots);

# make minimap2 index, run alignments, sumamrise hits
run_minimap2_alignments();

# read alignment index
read_minimap2_index();

# generate the hit summary
hit_summary();

# parse repeats if provided
if ($repeats){
    parse_repeats();
}


#---ITERATIVE STEP---

my $convergence = 0;
my $passes = 1;


while(!($convergence)){
    
    #msg("\n\n###\n\nRUNNING PURGING PASS $passes\n\n###\n");
        
    # read through blastn hit summary and get top 2 matches for each suspect contig
    get_contig_hits();

    # run mummer steps
    pairwise_alignments();
    
    # remove conflict reassignments
    check_assignments();
    
    # add to reassignments list
    add_reassignments();
}


#---GENERATE OUTPUT---


# check overpurging
over_purge_check();

msg("\n\n###\n\nGENERATING OUTPUT\n\n###\n");

# get the reassignment paths
get_reassignment_paths();

# write the table and new assembly
write_assembly();


msg("\n\n###\n\nPURGE HAPLOTIGS HAS COMPLETED SUCCESSFULLY!\n\n###\n");

exit(0);


#---SUBROUTINES---

sub pre_flight {
    
    # directories
    for my $dir ($TMP_DIR, $MINCE_DIR, $TMP_ALN, $COV_DIR, $ERR_DIR){
        if (!(-d $dir)){
            mkdir $dir or err("failed to create directory $dir");
        }
    }

    if ($dotplots){
        for my $dir ($ASSIGNED, $UNASSIGNED){
            if (!(-d $dir)){
                mkdir $dir or err("failed to create directory $dir");
            }
        }
    }
    
    # cleanup
    for my $file ($out_artefacts, $out_fasta, $out_haplotigs, $out_reassignments, $contig_paths){
        if (-s $file){
            unlink $file or err("failed to clean up previous run output file: $file");
        }
    }

}



sub read_fasta_fai {
    # index if needed
    if (!(-s "$genome.fai")){
        msg("Indexing $genome");
        runcmd({ command => "samtools faidx $genome 2> $ERR_DIR/samtools.faidx.stderr",
                 logfile => "$ERR_DIR/samtools.faidx.stderr",
                 silent => 1 });
    }
    
    # read contig lengths
    msg("Reading $genome.fai");
    
    open my $FAI, '<',  "$genome.fai" or err ("failed to open  $genome.fai for reading");
    while(my $l = <$FAI>){
        my @line = split /\s+/, $l;
        $line[0] =~ s/\|.*$//;
        if (!($line[0]) || !($line[1])){
            err("bad entry in $genome.fai index file? line:\n$l");
        } else {
            $contigLEN{$line[0]} = $line[1];
            $contigMLEN{$line[0]} = $line[1];
            $contigFAI{$line[0]} = $l;
        }
    }
    close $FAI;
    
    return;
}



sub read_cov_stats {
    msg("Reading $coverage_stats");
    
    open my $CSV, '<', $coverage_stats or err("failed to open $coverage_stats for reading");
    
    while(my $l = <$CSV>){
        next if ($l =~ /^#/);
        
        my @line = split /,/, $l;
        if (($line[0]) && !($contigLEN{$line[0]})){
            err("no contig \"$line[0]\" in genome index file, csv line:\n$l");
        } elsif ($line[1] eq 's'){
            $suspects{$line[0]} = 1;
        } elsif ($line[1] eq 'j'){
            $junk{$line[0]} = 1;
        }
    }
    
    close $CSV;
    
    return;
}



sub unconcatenate_genome {
    # check if needed
    MINCE_CHECK: for my $ctg (keys %contigLEN){
        if (!(-s "$MINCE_DIR/$ctg.fasta")){
            msg('"Un-concatenating" genome');
            run_unconcatenate();
            last MINCE_CHECK;
        }
    }

    return;
}



sub run_unconcatenate {
    open my $GEN, '<', $genome or err("failed to open $genome for reading");
    my $OUT;

    while (my $l = <$GEN>) {
        if ($l !~ /^>/) {
            print $OUT $l;
        } else {
            $l =~ s/\n//;
            $l =~ s/\s.+$//;   # remove fasta descriptions
            $l =~ s/\|.+$//;   # remove |quiver|arrow|etc
            $l =~ s/^>//;      # remove fasta separator
            close $OUT if ($OUT);
            open $OUT, '>', "$MINCE_DIR/$l.fasta" or err("failed to open \"$MINCE_DIR/$l.fasta\" for writing");
            print $OUT ">$l\n";
        }
    }

    close $OUT;
    close $GEN;
    
    return;
}



sub get_window_coverage {
    # check the bam is indexed
    if (!(-s "$bam_file.bai")){
        msg("Indexing $bam_file");
        runcmd({ command => "samtools index $bam_file 2> $ERR_DIR/samtools.index.stderr",
                 logfile => "$ERR_DIR/samtools.index.stderr",
                 silent => 1 });
    }

    # check for temp files from previous runs
    if (-s "$COV_DIR/$genome_file_name.mcov.tmp"){
        unlink "$COV_DIR/$genome_file_name.mcov.tmp" or err("Failed to clean up temp file $COV_DIR/$genome_file_name.mcov.tmp");
    }
    
    # make the bed windows for each contig
    if (!(-s "$COV_DIR/$genome_file_name.mcov")){
        msg('Getting windowed read-depth for each contig');
        bedtools_multicov();
    } else {
        msg('Reusing windowed read-depth from previous run');
    }
    
    # convert to log2 read-depth
    LOG_COV_CHECK: for my $ctg (keys %contigLEN){
        if (!(-s "$COV_DIR/$ctg.logcov")){
            msg('Generating log2(read-depth / average read-depth) coverages for plotting later');
            
            # get average read depth
            my $average = average_read_depth();

            cov_2_logcov($average);
            
            last LOG_COV_CHECK;
        }
    }
    
    # cleanup
    for my $ctg (keys %contigLEN){
        for my $file ("$COV_DIR/$ctg.wind", "$COV_DIR/$ctg.g"){
            if (-s $file){
                unlink $file or err("failed to clean up temp file $file");
            }
        }
    }

    return;
}



sub bedtools_multicov {
    for my $ctg ( sort { $contigLEN{$b} <=> $contigLEN{$a} } keys %suspects){
        # make the window file if needed
        if (!(-s "$COV_DIR/$ctg.wind")){

            # calculate window len
            my $win = int($contigLEN{$ctg} / $max_windows);
            $win = $min_win_size if ($win < $min_win_size);
            my $step = int($win / 2);

            # print genome file, we need to use the fasta fai entry as the contig may have |arrow or |quiver etc
            open my $GFAI, '>', "$COV_DIR/$ctg.g" or err ("failed to open $COV_DIR/$ctg.g for writing");
            print $GFAI $contigFAI{$ctg};
            close $GFAI;

            # make windows
            runcmd({ command => "bedtools makewindows -g $COV_DIR/$ctg.g -w $win -s $step > $COV_DIR/$ctg.wind.tmp 2> $ERR_DIR/bedtools.mkwind.stderr  &&  mv $COV_DIR/$ctg.wind.tmp $COV_DIR/$ctg.wind",
                     logfile => "$ERR_DIR/bedtools.mkwind.stderr",
                     silent => 1 });
        }

        # add the job to the queue
        $queueBedtools->enqueue($ctg);
    }
    
    # finalise the queue
    $queueBedtools->end();
    
    # spawn the worker threads
    for (1..$limit_io){
        $available_threads->down(1);
        threads->create(\&multicov_job);
    }
    
    # wait for workers to finish
    $available_threads->down($threads);
    $available_threads->up($threads);
    
    # join workers
    for my $thr (threads->list()){
        $thr->join();
    }
    
    # finish multicov file
    rename "$COV_DIR/$genome_file_name.mcov.tmp","$COV_DIR/$genome_file_name.mcov";
    
    return;
}



sub multicov_job {
    # iterate over the queue until all jobs are done
    while (defined(my $ctg = $queueBedtools->dequeue())) {
        my @mcov;
        
        # use a pipe to run bedtools multicov
        open my $INTMP, "bedtools multicov -bams $bam_file -bed $COV_DIR/$ctg.wind |" or err("failed to open pipe \"bedtools multicov -bams $bam_file -bed $COV_DIR/$ctg.wind |\"");
        while(<$INTMP>){
            push @mcov, $_;
        }
        close $INTMP;
        
        # write the slurped file
        $writing_to_out->down(1);
        open my $OUTTMP, '>>', "$COV_DIR/$genome_file_name.mcov.tmp" or err("failed to open $COV_DIR/$genome_file_name.mcov.tmp for appending");
        print $OUTTMP @mcov;
        close $OUTTMP;
        $writing_to_out->up(1);
    }
    
    # exit thread
    $available_threads->up(1);

    return;
}



sub average_read_depth {
    my @wind_cov_out;
    my $cur_ctg;
    my @average_depth;

    # generate histogram table files for each contig, dump them in the minced directory
    open my $MCV, "$COV_DIR/$genome_file_name.mcov" or err("Failed to open $COV_DIR/$genome_file_name.mcov for reading");
    
    while(<$MCV>){
        s/\n//;
        if ($_){
            my @l = split /\s+/;
            $l[0] =~ s/\|.+//; # cut off |quiver|arrow|etc
            if (!($cur_ctg)){
                $cur_ctg = $l[0];
            } elsif ($cur_ctg ne $l[0]){
                # dump the output when we hit a new contig
                write_cov_out($cur_ctg, \@wind_cov_out);
                # reset
                $cur_ctg = $l[0];
                @wind_cov_out = ();
            }
            my $p = ($l[1] + $l[2]) / 2;
            my $d = $l[3] / ($l[2] - $l[1]);
            push @wind_cov_out, "$p\t$d\n";
            push @average_depth, $d;
        }
    }
    close $MCV;

    # dump the last contig
    write_cov_out($cur_ctg, \@wind_cov_out);

    # calculate the average
    my $avg = sum(@average_depth) / @average_depth;
    
    return $avg;
}



sub write_cov_out {
    my $ctg = $_[0];
    my @wind_cov = @{$_[1]};
    open my $TMC, ">$COV_DIR/$ctg.cov" or err("Failed to open $COV_DIR/$ctg.cov for writing");
    print $TMC @wind_cov;
    close $TMC;
    return;
}



sub cov_2_logcov {
    my $average = $_[0];
    
    for my $ctg (keys %suspects){
        
        # check if needed
        if (!(-s "$COV_DIR/$ctg.logcov")){
            
            # open cov file for reading and tmp file for writing
            open my $COV, '<', "$COV_DIR/$ctg.cov" or err("Failed to open $COV_DIR/$ctg.cov for reading");
            open my $TMP, '>', "$COV_DIR/$ctg.logcov.tmp" or err("Failed to open $COV_DIR/$ctg.cov.tmp for writing");

            # convert to log2 read-depth
            while(<$COV>){
                my@l = split /\s+/;
                if ($l[1]==0){
                    $l[1] = -1;
                } else {
                    $l[1] = log($l[1] / $average) / log(2);
                }
                
                # we'll cap the extremes to -1.5 and 1.5
                $l[1] = -1.5 if ($l[1] < -1.5);
                $l[1] = 1.5 if ($l[1] > 1.5);

                print $TMP "$l[0]\t$l[1]\n";
            }
            close $COV;
            close $TMP;

            rename "$COV_DIR/$ctg.logcov.tmp", "$COV_DIR/$ctg.logcov";
        }
    }
    
    return;
}



sub run_minimap2_alignments {
    
    # build assembly.fasta
    if (!(-s $assembly_fasta)){
        for my $contig (sort keys %contigLEN){
            if (!($junk{$contig})){
                qruncmd("cat $MINCE_DIR/$contig.fasta >> $assembly_fasta");
            }
        }
    }
    
    # build index for assembly
    if(!(-s $assembly_index)){
        msg('Building minimap2 index of assembly');
        runcmd ({ command => "minimap2 -I $minimiser_drop -t $threads -d $assembly_index $assembly_fasta 2> $ERR_DIR/minimap2.idx.stderr",
                  logfile => "$ERR_DIR/minimap2.idx.stderr",
                  silent => 1 });
    }
    
    # cleanup
    if (-s $suspects_fasta){
        unlink $suspects_fasta;
    }
    
    # run the alingments if they're needed
    if ((-s $minimap2PAF) &&(-s $minimap2IDX)){
        msg('Reusing minimap2 alignments from previous run');
    } else {
        msg('Preparing to run minimap2');
        
        for my $contig (sort { $contigLEN{$b} <=> $contigLEN{$a} } keys %suspects){
                qruncmd("cat $MINCE_DIR/$contig.fasta >> $suspects_fasta");
        }
        
        # start the minimap2 alignments
        run_minimap2();
        
        msg('Finished minimap2 alignments');
    }
    
    return;
}



sub run_minimap2 {
    msg('Performing minimap2 alignments');
    
    # cleanup old files
    if (-s "$minimap2PAF.tmp"){
        unlink "$minimap2PAF.tmp";
    }
    
    ### run minimap2 ###
    # open a pipe to the minimap2 job
    runcmd ({ command => "minimap2 $minimap2_parameters -t $threads $assembly_index $suspects_fasta 2> $ERR_DIR/minimap2.stderr > $minimap2PAF.tmp",
              logfile => "$ERR_DIR/minimap2.stderr",
              silent => 1 });
    
    # finalize the alignment output
    rename "$minimap2PAF.tmp", $minimap2PAF;
    
    ### build the index of the alignments ###
    msg('Indexing minimap2 alignments');
    
    # open the alignments for reading
    open my $FWR, '<', $minimap2PAF or err("failed to open $minimap2PAF for reading");
    
    # open filehandle for alignment index
    open my $IDX, '>', "$minimap2IDX.tmp" or err("failed to open $minimap2IDX.tmp for writing");
    
    # tracking for index file
    my $curCtg = 'init';
    my $offset = tell($FWR);
    
    # generate the index file
    while(<$FWR>){
        my ($ctg) = $_ =~ m/^(.+?)\s/;
        if ($curCtg ne $ctg){
            print $IDX $ctg, "\t", $offset, "\n";
            $curCtg = $ctg;
        }
        $offset = tell($FWR);
    }
    close $FWR;
    close $IDX;
    
    # finalize the index file
    rename "$minimap2IDX.tmp", $minimap2IDX;
    
    return;
}



sub read_minimap2_index {
    msg('Reading index of minimap2 alignments');
    
    open my $IDX, '<', $minimap2IDX or err("failed to open $minimap2IDX for reading");
    
    while(<$IDX>){
        my@l=split/\s+/;
        $mmIndex{$l[0]} = $l[1];
    }
    
    close $IDX;
    
    return;
}



sub hit_summary {
    # check if needed
    if (-s $hit_summary){
        msg('Reusing hit summary file from previous run');
    } else {
    
        msg('Preparing contig hit summary');
        
        # cleanup
        if (-s "$hit_summary.tmp"){
            unlink "$hit_summary.tmp";
        }
        
        # queue up suspect contigs
        for my $contig (sort { $contigLEN{$b} <=> $contigLEN{$a} } keys %suspects){
            $queueHitSummary->enqueue($contig);
        }
        
        # finalise queue
        $queueHitSummary->end();
        
        # spawn worker threads for hit summary
        for (1..$threads){
            $available_threads->down(1);
            threads->create(\&hit_summary_worker);
        }
        
        # wait on remaining jobs
        $available_threads->down($threads);
        $available_threads->up($threads);
        
        # join workers
        for my $thr (threads->list()){
            $thr->join();
        }
        
        # finalise the hit summary
        rename "$hit_summary.tmp", $hit_summary;
    }
    
    # slurp the hits
    open my $TSV, $hit_summary or err("failed to open $hit_summary for reading");
    
    while(my $l = <$TSV>){
        my @line = split /\s+/, $l;
        if (!($hits{$line[0]})){
            my @h :shared;
            $hits{$line[0]} = \@h;
        }
        push @{$hits{$line[0]}}, $line[1];
    }
    close $TSV;
    
    return;
}



sub hit_summary_worker {
    # iterate over the queue until no more jobs
    while (defined(my $ctg = $queueHitSummary->dequeue())) {
        
        # collect hit contig total matching residues and print PAF
        my %hits;
        
        # open the alignment file for reading
        open my $FWR, '<', $minimap2PAF or err("failed to open $minimap2PAF for reading");
        
        # fast-forward to to the correct location in the alignment file
        seek($FWR, $mmIndex{$ctg}, 0);
        
        # grab the hits
        while(<$FWR>){
            my@l=split/\s+/;
            last if ($l[0] ne $ctg);
            if ($l[0] ne $l[5]){
                $hits{$l[5]}+=$l[9];
            }
        }
        
        # filter the hits
        for my $hit (keys %hits){
            if (($hits{$hit} / $contigLEN{$ctg}) * 100 < $hit_cutoff){ 
                delete $hits{$hit};
            }
        }
        
        # prepare the output
        my @out;
        for my $outHit (sort { $hits{$b} <=> $hits{$a} } keys %hits){
                push @out, "$ctg\t$outHit\n";
        }
        
        # write the hits to the summary file
        $writing_to_out->down(1);
        open my $HIT, '>>', "$hit_summary.tmp" or err("failed to open $hit_summary.tmp for appending");
        print $HIT @out;
        close $HIT;
        $writing_to_out->up(1);
    }
    
    $available_threads->up(1);
    
    return;
}



sub parse_repeats {
    msg("Parsing repeat annotations from $repeats");
    
    # parse the BED file, add intervals to global hash and print contig bed files on the fly
    # we'll pass this through bedtools as a format test and to ensure overlaps are merged
    runcmd({ command => "cat $repeats | sort -k1,1 -k2,2n -k3,3n | bedtools merge > $assembly_repeats.tmp 2> $ERR_DIR/bedtools_merge.stderr",
             logfile => "$ERR_DIR/bedtools_merge.stderr",
             silent => 1 });
    
    # finalize
    rename "$assembly_repeats.tmp", $assembly_repeats;
    
    # open the newely generated repeats file for reading
    open my $BED, '<', $assembly_repeats or err("Failed to open $assembly_repeats for reading");
    
    # iterate repeats
    my $ctg = 'init';
    my $OUT;
    
    while(<$BED>){
        next if (/^#/); 
        next if (/^\s+$/);
        my @l = split /\s+/;
        
        # clean the contig name
        $l[0] =~ s/\|.+//;
        
        # check if new contig
        if ($ctg ne $l[0]){
            close $OUT if ($OUT);
            $ctg = $l[0];
            open $OUT, '>', "$MINCE_DIR/$ctg.bed" or err("Failed to open $MINCE_DIR/$ctg.bed for writing");
        }
        
        # print
        print $OUT "$l[0]\t$l[1]\t$l[2]\n";
        
        # subtract mask interval from the contig len
        $contigMLEN{$l[0]} -= ($l[2] - $l[1]);
        
    }
    close $BED;
    close $OUT if ($OUT);
    
    return;
}



#---ITERATIVE STEP---



sub get_contig_hits {
    msg('Reading contig hits from hit summary');
    
    # remove reference contigs if they themselves have been reassigned 
    for my $ctg (keys %suspects){
        next if ($contigREASSIGN{$ctg});
        if ($contigHIT1{$ctg}){
            if ($contigREASSIGN{$contigHIT1{$ctg}}){
                undef $contigHIT1{$ctg};
                undef $contigHIT2{$ctg};
                $contigASSIGN{$ctg} = 0;
            }
        }
        if ($contigHIT2{$ctg}){
            if ($contigREASSIGN{$contigHIT2{$ctg}}){
                undef $contigHIT2{$ctg};
                $contigASSIGN{$ctg} = 0;
            }
        }
    }
    
    # add best non-reassigned reference contigs for each contig 
    for my $ctg (keys %suspects){
        if ($hits{$ctg}){
            for my $hit (@{$hits{$ctg}}){
                if (!($contigREASSIGN{$ctg}) && !($contigREASSIGN{$hit})){
                    if (!($contigHIT1{$ctg})){
                        $contigHIT1{$ctg} = $hit;
                        $contigASSIGN{$ctg} = 0;
                    } elsif (!($contigHIT2{$ctg}) && ($hit ne $contigHIT1{$ctg})){
                        $contigHIT2{$ctg} = $hit;
                        $contigASSIGN{$ctg} = 0;
                    }
                }
            }
        }
    }
    
    return;
}



sub pairwise_alignments {
    msg('Performing pairwise comparisons on contig hits');
    
    my $job = 0;
    $queuePairwise = Thread::Queue->new();
    
    CTG: for my $contig (sort { $contigLEN{$b} <=> $contigLEN{$a} } keys %suspects){
        next CTG if ($contigREASSIGN{$contig});
        next CTG if ($contigASSIGN{$contig});
        
        # skip if no hits
        if (!($contigHIT1{$contig})){
            $contigASSIGN{$contig} = 'n';
            $contigBM{$contig} = '-';
            $contigMM{$contig} = '-';
            if (-s "$UNASSIGNED/$contig.png"){
                unlink "$UNASSIGNED/$contig.png";
            }
            next CTG;
        }
        
        # queue the pairwise comparison
        $queuePairwise->enqueue([$job, $contig]);
        $job++;


    }
    
    # finalise queue
    $queuePairwise->end();
    
    # spawn worker threads
    for (1..$limit_io){
        $available_threads->down(1);
        threads->create(\&pairwise_worker);
    }
    
    # wait on remaining jobs
    $available_threads->down($threads);
    $available_threads->up($threads);

    # join workers
    for my $thr (threads->list()){
        $thr->join();
    }
    
    return;
}



sub pairwise_worker {
    
    while (defined(my $args = $queuePairwise->dequeue())) {
        my $job = @{$args}[0];
        my $contig = @{$args}[1];
        
        my $alignments;
        my $bestmatch=0;
        my $maxmatch=0;
        my $assignment;

        my $ref1 = $contigHIT1{$contig};
        my $ref2 = $contigHIT2{$contig} if ($contigHIT2{$contig});
        
        # check if the contig is 100% repeat
        if ($contigMLEN{$contig} == 0){
            $assignment = "r";
        } else {

            # get minimap2 alignments for ref1 and ref2
            ($ref1, $ref2, $alignments) = minimap2_alignments($ref1, $ref2, $contig, $job);
            
            # get 'maxmatch' and 'bestmatch' coverages from the sorted general output of minimap2, subtract masking regions on the fly
            ($bestmatch, $maxmatch) = get_bm_mm(\@$alignments, $contig);
            
            # guess the assignment
            $assignment = guess_assignment($bestmatch, $maxmatch);


            # make the dotplot in unassigned dir
            if ($dotplots){
                if (-s "$UNASSIGNED/$contig.png"){
                    unlink "$UNASSIGNED/$contig.png" or err("failed to clean up previous dotplot $UNASSIGNED/$contig.png");
                }

                # perform a check to see if either or both reference alignments come up empty
                if ($assignment ne "n"){
                    dotplots($ref1, $ref2, $contig, $job);
                }
            }
        }
        
        
        # print the reassignments
        $writing_to_out->down(1);
        $contigASSIGN{$contig} = $assignment;
        $contigBM{$contig} = $bestmatch;
        $contigMM{$contig} = $maxmatch;
        $writing_to_out->up(1);
        
        # clean up 
        for my $file ("$TMP_ALN/$job.Rscript.stderr",
                      "$TMP_ALN/$job.1.rdotplot", 
                      "$TMP_ALN/$job.2.rdotplot"){
            if (-e $file){
                unlink $file or err("failed to clean up temp file $file");
            }
        }
    }

    # exit
    $available_threads->up(1);
    
    return;
}



sub minimap2_alignments {
    my $ref1 = $_[0];
    my $ref2 = $_[1];
    my $contig = $_[2];
    my $job = $_[3];
    
    my @r1paf;
    my @r2paf;
    my @rbed;
    my @rsbed;
    
    # alignments
    open my $FWR, '<', $minimap2PAF or err("failed to open $minimap2PAF for reading");
    seek($FWR, $mmIndex{$contig}, 0);
    while(<$FWR>){
        my@l=split/\s+/;
        last if ($l[0] ne $contig);
        if ($l[5] eq $ref1){
            push @r1paf, $_;
        } elsif (($ref2) && ($l[5] eq $ref2)){
            push @r2paf, $_;
        }
    }
    close $FWR;
    
    if (!(@r1paf)){
        $ref1 = 0;
    }
    if($ref2){
        if (!(@r2paf)){
            $ref2 = 0;
        }
    }
    
    # make rdotplot files for plotting dotplots
    if (($dotplots)&&($job ne 'check')){
        my $TDP;
        if ($ref1){
            open $TDP, '>', "$TMP_ALN/$job.1.rdotplot" or err("failed to open $TMP_ALN/$job.1.rdotplot fro writing");
            for my $line (@r1paf){
                my @l=split/\s+/,$line;
                if ($l[4] eq '+'){
                    print $TDP "$l[2]\t$l[7]\n$l[3]\t$l[8]\nNA\tNA\n";
                } else {
                    print $TDP "$l[3]\t$l[7]\n$l[2]\t$l[8]\nNA\tNA\n";
                }
            }
            close $TDP;
        }
        if ($ref2){
            open $TDP, '>', "$TMP_ALN/$job.2.rdotplot" or err("failed to open $TMP_ALN/$job.2.rdotplot fro writing");
            for my $line (@r2paf){
                my @l=split/\s+/,$line;
                if ($l[4] eq '+'){
                    print $TDP "$l[2]\t$l[7]\n$l[3]\t$l[8]\nNA\tNA\n";
                } else {
                    print $TDP "$l[3]\t$l[7]\n$l[2]\t$l[8]\nNA\tNA\n";
                }
            }
            close $TDP;
        }
    }
    
    # only need the contig coordinates
    if ($ref1){
        for my $line (@r1paf){
            my @l=split/\s+/,$line;
            push @rbed, [$l[2],$l[3]];
        }
    }
    
    if ($ref2){
        for my $line (@r2paf){
            my @l=split/\s+/,$line;
            push @rbed, [$l[2],$l[3]];
        }
    }
    
    # sort
    @rbed = sort { $a->[0] <=> $b->[0] } @rbed;
    
    # subtract repeats if needed
    if ($repeats){
        @rsbed = sub_repts(\@rbed, $contig);
    } else {
        @rsbed = @rbed;
    }
    
    return ($ref1, $ref2, \@rsbed);
}



sub sub_repts {
    my $bed = $_[0];
    my $contig = $_[1];
    
    my $rep = "$MINCE_DIR/$contig.bed";
    my $ali = "$TMP_ALN/$contig.ali";
    
    my @out;
    
    if (-s "$MINCE_DIR/$contig.bed"){
        
        
        # prepare for piping through bedtools
        open my $TMP, '>', $ali or err("Failed to open $ali for writing");
        for my $al (@{$bed}){
            print $TMP "$contig\t@{$al}[0]\t@{$al}[1]\n";
        }
        close $TMP;
        
        # subtract alignments
        open $TMP, "bedtools subtract -a $ali -b $rep |" or err("Failed to open pipe bedtools subtract -a $ali -b $rep |");
        while(<$TMP>){
            my@l=split/\s+/;
            push @out, [ $l[1],$l[2] ];
        }
        close $TMP;
        
        # cleanup
        unlink $ali if (-e $ali);
        
    } else {
        @out = @{$bed};
    }
    
    return @out;
}



sub get_bm_mm {
    my @bed = @{$_[0]};
    my $contig = $_[1];
    
    my $bm=0;
    my $mm=0;
    
    
    my @p;
    for my $l (@bed){
        $mm+=($l->[1] - $l->[0]);
        if (@p){
            next if (($l->[0] > $p[0]) && ($l->[1] < $p[1]));
            if ($l->[0] > $p[1]){
                $bm+=($p[1]-$p[0]);
                @p=($l->[0], $l->[1]);
            } elsif ($p[1] < $l->[1]) {
                $p[1] = $l->[1];
            } 
        } else {
            @p=($l->[0], $l->[1]);
        }
    }

    $bm+=($p[1]-$p[0]) if (@p);

    if ($repeats){
        $mm = sprintf "%.2f", ($mm/$contigMLEN{$contig}) * 100;
        $bm = sprintf "%.2f", ($bm/$contigMLEN{$contig}) * 100;
    } else {
        $mm = sprintf "%.2f", ($mm/$contigLEN{$contig}) * 100;
        $bm = sprintf "%.2f", ($bm/$contigLEN{$contig}) * 100;
    }
    
    return ($bm, $mm);
}



sub guess_assignment {
    my $assignment;
    if ($_[0] >= $bestmatch_cutoff){
        if ($_[1] >= $maxmatch_cutoff){
            $assignment = "r";
        } else {
            $assignment = "h";
        }
    } elsif ($_[0] < $low_cutoff){
        $assignment = "n";
    } else {
        $assignment = "u";
    }
    return $assignment;
}



sub dotplots {
    my $ref1 = $_[0];
    my $ref2 = $_[1];
    my $contig = $_[2];
    my $job = $_[3];
    my $cmd;
    
   
    if (($ref2) && ($ref1)){
        $cmd = "$RealBin/../scripts/dot_plot.Rscript $UNASSIGNED/$contig.png $contig $contigLEN{$contig} $COV_DIR/$contig.logcov $ref1 $TMP_ALN/$job.1.rdotplot $contigLEN{$ref1} $ref2 $TMP_ALN/$job.2.rdotplot $contigLEN{$ref2} 1> $TMP_ALN/$job.Rscript.stderr 2>&1\n";
    } elsif (($ref1) && !($ref2)) {
        $cmd = "$RealBin/../scripts/dot_plot.Rscript $UNASSIGNED/$contig.png $contig $contigLEN{$contig} $COV_DIR/$contig.logcov $ref1 $TMP_ALN/$job.1.rdotplot $contigLEN{$ref1} 1> $TMP_ALN/$job.Rscript.stderr 2>&1\n";
    } elsif (($ref2) && !($ref1)){
        $cmd = "$RealBin/../scripts/dot_plot.Rscript $UNASSIGNED/$contig.png $contig $contigLEN{$contig} $COV_DIR/$contig.logcov $ref2 $TMP_ALN/$job.2.rdotplot $contigLEN{$ref2} 1> $TMP_ALN/$job.Rscript.stderr 2>&1\n";
    }

    if ($cmd){
        runcmd({ command => $cmd, logfile => "$TMP_ALN/$job.Rscript.stderr", silent => 1 });
    } else {
        err("Contig $contig returned alignment score but no rdotplot files");
    }
    return;
}



sub check_assignments {
    msg('Checking contig assignments for conflicts');
    
    # check all assignments for conflicts
    for my $ctg (sort keys %suspects){
        next if ($contigASSIGN{$ctg} !~ /[rh]/i);
        next if ($contigREASSIGN{$ctg});
        if ($contigREASSIGN{$contigHIT1{$ctg}}){
            err('ref seq was already reassigned, this should not have happened');
        }
        
        my $r_ctg = $contigHIT1{$ctg};
        if (($contigASSIGN{$r_ctg})&&($contigASSIGN{$r_ctg} =~ /[rh]/i)){
            msg("CONFLICT: $ctg and it's match $r_ctg both flagged for reassignment");
            
            # just keep the longer contig
            if ($contigLEN{$ctg} > $contigLEN{$r_ctg}){
                $contigASSIGN{$ctg} = 0;
                msg("\tKeeping longer contig $ctg");
            } else {
                $contigASSIGN{$r_ctg} = 0;
                msg("\tKeeping longer contig $r_ctg");
            }
        }
    }
    return;
}



sub add_reassignments {
    msg('Logging reassignments and checking for convergence');
    
    my $convergence_check = 1;
    
    for my $ctg(sort keys %suspects){
        next if ($contigREASSIGN{$ctg});
        
        if ($contigASSIGN{$ctg} =~ /[rh]/i){
            $contigREASSIGN{$ctg} = 1;
            $convergence_check = 0;
            if (-s "$UNASSIGNED/$ctg.png"){
                rename "$UNASSIGNED/$ctg.png", "$ASSIGNED/$ctg.png";
            }
        }
    }
    
    # convergence check
    if ($convergence_check){
        $convergence = 1;
        msg('Convergence reached!');
    } else {
        msg('Convergence not reached, more passes needed');
    }
    
    $passes++;
    return;
}



sub over_purge_check {
    msg('Checking for over-purging');
    
    # first round is to detect over-purged contigs
    $over_purge_mode = 'detect';
    
    $queueOverPurge = Thread::Queue->new();
    
    # queue up all reassigned contigs
    for my $ctg(sort keys %suspects){
        if ($contigREASSIGN{$ctg}){
            $queueOverPurge->enqueue($ctg);
        }
    }
    
    # finalise queue
    $queueOverPurge->end();
    
    # spawn workers to check if still satisfy conditions of haplotig
    for (1..$limit_io){
        $available_threads->down(1);
        threads->create(\&over_purge_worker);
    }
    
    # wait on remaining jobs
    $available_threads->down($threads);
    $available_threads->up($threads);

    # join workers
    for my $thr (threads->list()){
        $thr->join();
    }
    
    msg('Fixing over-purged contigs');
    
    # second round is to fix over-purged contigs
    $over_purge_mode = 'fix';
    
    $queueOverPurge = Thread::Queue->new();
    
    # queue up all over-purged contigs
    for my $ctg(sort { $contigLEN{$b} <=> $contigLEN{$a} } keys %contigOVPURG){
        $queueOverPurge->enqueue($ctg);
    }
    
    # finalise queue
    $queueOverPurge->end();
    
    # fix contigs
    $available_threads->down(1);
    over_purge_worker();
    
    return;
}



sub over_purge_worker {
    while (defined(my $ctg = $queueOverPurge->dequeue())) {
        
        # add hits for contig
        my $ref1;
        my $ref2;
        my $alignments;
        
        for my $hit (@{$hits{$ctg}}){
            if (!($contigREASSIGN{$hit})){
                if (!($ref1)){
                    $ref1 = $hit;
                } elsif (!($ref2) && ($hit ne $ref1)){
                    $ref2 = $hit;
                }
            }
        }
        
        # not hits = over-purged
        if (!($ref1)){
            if ($over_purge_mode eq 'detect'){
                $contigOVPURG{$ctg} = 1;
            } else {
                $contigREASSIGN{$ctg} = 0;
                msg("\tContig $ctg added back to primay assembly");
            }
        } else {
        
            # get minimap2 alignments for ref1 and ref2
            ($ref1, $ref2, $alignments) = minimap2_alignments($ref1, $ref2, $ctg, 'check');
            
            # get 'maxmatch' and 'bestmatch' coverages from the sorted general output of minimap2, subtract masking regions on the fly
            my ($bestmatch, $maxmatch) = get_bm_mm(\@$alignments, $ctg);
            
            # guess the assignment
            my $assignment = guess_assignment($bestmatch, $maxmatch);
            
            # check if over-purged
            if ($assignment !~ /[rh]/i){
                if ($over_purge_mode eq 'detect'){
                    $contigOVPURG{$ctg} = 1;
                } else {
                    $contigREASSIGN{$ctg} = 0;
                    if (-s "$ASSIGNED/$ctg.png"){
                        qruncmd("mv $ASSIGNED/$ctg.png $UNASSIGNED/$ctg.png");
                    }
                    msg("\tContig $ctg added back to primary assembly");
                }
            }
        }
        
    }
    
    # exit
    $available_threads->up(1);
    
    return;
}



#---END ITERATIVE STEP---



sub get_reassignment_paths {
    msg('Writing contig association paths');
    
    # get contigs that are references, and contigs that are references AND not themselves reassigned
    for my $ctg (sort keys %contigLEN){
        if ($contigREASSIGN{$ctg}){
            push @{$refs{$contigHIT1{$ctg}}}, $ctg;
            if ( !($primaries{$contigHIT1{$ctg}}) && !($contigREASSIGN{$contigHIT1{$ctg}}) ){
                $primaries{$contigHIT1{$ctg}} = 1;
            }
            
            # rename the ASSIGN key for graph output
            if ($contigASSIGN{$ctg} eq "h"){
                $contigASSIGN{$ctg} = "HAPLOTIG";
            } elsif ($contigASSIGN{$ctg} eq "r"){
                $contigASSIGN{$ctg} = "REPEAT";
            } else {
                err("unknown reassignment $contigASSIGN{$ctg}, this shouldn't have happened")
            }
        }
    }
    
    open $PTH, '>', $contig_paths or err("failed to open $contig_paths for writing");
    
    # use the primaries to recursively find the association path
    for my $ctg (sort keys %primaries){
        @current_path = ("$ctg,PRIMARY");
        @current_path_rename = @current_path;
        $current_depth = 0;
        find_path($ctg);
        print $PTH "\n";
    }
    return;
}



sub find_path {
    my $ref_ctg = $_[0];
    
    if (!($refs{$ref_ctg})){
        print $PTH @current_path;
        print $PTH "\n";
        my $suffix;
        for (@current_path_rename){
            my @ctg = split /,/;
            if (!($ctg[1] =~ /PRIMARY/)){
                err(@current_path_rename) if (!($suffix));
                $contigREASSIGN{$ctg[0]} = "$ctg[1]$suffix";
                $suffix = "<--$ctg[0]_$ctg[1]$suffix";
            } else {
                $suffix = "<--$ctg[0]_$ctg[1]";
            }
        }
    } else {
        for my $ctg (@{$refs{$ref_ctg}}){
            push @current_path, " -> $ctg,$contigASSIGN{$ctg}";
            push @current_path_rename, "$ctg,$contigASSIGN{$ctg}";
            $current_depth += 1;
            
            find_path($ctg);
            
            pop @current_path;
            pop @current_path_rename;
            $current_depth -= 1;
            for (0..$current_depth){
                $current_path[$_] =~ s/./ /g;
            }
        }
    }
    return;
}



sub write_assembly {
    msg('Writing the reassignment table and new assembly files');
    
    open my $CUH, '>', $out_haplotigs or err("failed to open $out_haplotigs for writing");
    open my $CUT, '>', $out_reassignments or err("failed to open $out_reassignments for writing");
    
    print $CUT "#reassigned_contig\ttop_hit_contig\tsecond_hit_contig\tbest_match_coverage\tmax_match_coverage\treassignment\n";
    for my $ctg (sort keys %contigLEN){
        if (($contigREASSIGN{$ctg}) && !($junk{$ctg})){
            write_seq($CUH, $ctg);
            my $c2 = $contigHIT2{$ctg} || "-";
            print $CUT "$ctg\t$contigHIT1{$ctg}\t$c2\t$contigBM{$ctg}\t$contigMM{$ctg}\t$contigASSIGN{$ctg}\n";
        }
    }
    
    print $CUT "#contigs_kept\n";
    for my $ctg (sort keys %contigLEN){
        if ( !($junk{$ctg}) && !($contigREASSIGN{$ctg}) ){
            my $c1 = $contigHIT1{$ctg} || "-";
            my $c2 = $contigHIT2{$ctg} || "-";
            my $bm = $contigBM{$ctg} || "-";
            my $mm = $contigMM{$ctg} || "-";
            print $CUT "$ctg\t$c1\t$c2\t$bm\t$mm\tKEEP\n";
            qruncmd("cat $MINCE_DIR/$ctg.fasta >> $out_fasta");
        }
    }
    
    print $CUT "#junk_contigs\n";
    for my $ctg (sort keys %contigLEN){
        if ($junk{$ctg}){
            qruncmd("cat $MINCE_DIR/$ctg.fasta >> $out_artefacts");
            print $CUT "$ctg\t-\t-\t-\t-\tJUNK\n";
        }
    }
    return;
}



sub write_seq {
    my $fh = $_[0];
    my $ctg = $_[1];
    
    open my $FA, "$MINCE_DIR/$ctg.fasta" or err("failed to open $MINCE_DIR/$ctg.fasta for reading");
    
    while(my $l = <$FA>){
        if ($l =~ /^>/){
            print $fh ">$ctg $contigREASSIGN{$ctg}\n";
        } else {
            print $fh $l;
        }
    }
    return;
}




