How to write Perl script to merge chromosome coordinates

README.md

How to write Perl script to merge chromosome coordinates

Usage: perl DMR_merge.pl DMR_region.txt DMR_region.merged.txt

Youtube link to explain this code:

https://www.youtube.com/watch?v=wxgvpQ2c-dY

DMR_merge.pl

#!/usr/bin/perl -w
use strict;

my ($DMR, $out) = @ARGV;

open DMR, $DMR or die "File not found: $!";
open OUT, "+>$out" or die "$!";

#read  a  line,
# go to next line
#     check overlap
#      if overlap: merge two regions. Then go to the next line.
#      if not overlap: print whatever we have now; then start from a line
while(my $region = <DMR>){
    chomp $region;
    my ($chrom1, $start1, $end1) = split(/\t/, $region);
    BLOCK:{
        my $new_region = <DMR>;

        if(!$new_region){
            print OUT "$chrom1\t$start1\t$end1\n";
        }else{
            chomp $new_region;
            my ($chrom2, $start2, $end2) = split(/\t/, $new_region);
             ## start1===============end1
             ##           start2=====================end2
             ## start1===============================new_end1
            if($chrom2 eq $chrom1 && $start2 >= $start1 && $start2 <=$end1){
                $end1 = $end2;
                redo BLOCK;
            }else{
                print OUT "$chrom1\t$start1\t$end1\n";
                ($chrom1, $start1, $end1) = ($chrom2, $start2, $end2);
                redo BLOCK;
            }
        }
    }
}

DMR_region.txt

chr1	100	200
chr1	150	250
chr1	200	300
chr1	500	600
chr1	550	650
chr2	300	800
chr2	400	1000
chr3	500	1000