prod_reproduction/202307-FMBY2/script/pre_plot.pl

#!/usr/bin/perl

use strict;
use warnings;
my (%data,%segs);
my $sam=shift;
my $fseg=$sam.'.seg';
my $fptn=$sam.'.ptn.tsv';
my $ftn=$sam.'.tn.tsv';
my @chrs=(1..22,'X','Y');
open my $tn_fh, '<', $ftn or die "Cannot open file:$ftn\n$!\n";

while(<$tn_fh>){
    chomp;
    next if /^#/ or /^contig/;
    #next unless /^chr/;
    my ($chr,$start,$end,$name,$val)=split /\t/;
    # my $id=join("\t",$chr,$start,$end,$name);
    # push @ids,$id;
    $chr=~s/^chr//;
    $data{$chr}{$start}{tn}=$val;      
    $name=~s/_\d+$//;
    $data{$chr}{$start}{name}=$end."\t".$name;
}
close($tn_fh);

open my $ptn_fh, '<', $fptn or die "Cannot open file:$!\n";
while(<$ptn_fh>){
    chomp;
    next if /^#/ or /^contig/;
    my ($chr,$start,$end,$name,$val)=split /\t/;    
    $chr=~s/^chr//;
    $data{$chr}{$start}{ptn}=$val;  
    # my $id=join("\t",$chr,$start,$end,$name);
    # push @ids,$id;
    # $data{$id}{ptn}=$val;  
    
}
close($ptn_fh);

open my $seg_fh, '<', $fseg or die "Cannot open file:$!\n";
while(<$seg_fh>){
    chomp;
    next if /^Sample/;
    my ($chr,$start,$end,$val)=(split /\t/)[1,2,3,5];
    $chr=~s/chr//;
    my $id=join("\t",$chr,$start,$end);
    $segs{$id}=$val;
}
close($seg_fh);

open my $wfh ,' >',$sam.'_plot.tsv' or die "Cannot write file:$!";
print $wfh join("\t",'#Chr','Start','End','Name','PTN','TN','Seg'),"\n";
for my $chr (@chrs){
    for my $start(sort {$a <=> $b } keys %{$data{$chr}}){
        my $ptn=$data{$chr}{$start}{ptn};
        my $tn=$data{$chr}{$start}{tn};
        my $name=$data{$chr}{$start}{name};
        my $seg_val;
        for my $seg_reg(keys %segs){
            my ($seg_chr,$seg_start,$seg_end)=split /\t/,$seg_reg;
            next unless $seg_chr eq $chr;
            if($start>= $seg_start and $start <= $seg_end){
                $seg_val=$segs{$seg_reg};
                last;
            }
        }
        print $wfh join("\t",$chr,$start,$name,$ptn,$tn,$seg_val),"\n";
    }

}