#!/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"; } }