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