#!/usr/bin/perl -- use warnings; use strict; use autodie; Main( @ARGV ); exit( 0 ); sub Main { #~ RPSFiles( @_ ); #~ RPSFiles( 'testReg.txt', 'testPos.txt', 'testOut.txt' ); RPSDemo(); } sub RPSFiles{ my( $region, $position , $writeOut ) = @_; use autodie; # die if open/close..... fails open my $Reg, '<', $region; open my $Pos, '<', $position; open my $Out, '>', $writeOut; RegPosOut910992 ( $Reg, $Pos, $Out ); } sub RegPosOut910992 { my( $Reg, $Pos, $Out ) = @_; my $rline; my $pline; while ($rline=<$Reg>) { chomp($rline); my @r_arr=split("\t",$rline); chomp($r_arr[0]); my @rID = split("r",$r_arr[0]); $r_arr[0] = $rID[1]; #this removes the "chr" portion of the first element and leaves number #i.e. instead of [0] -> "chr24"; [0] -> "24" while($pline=<$Pos>) { if(!$rline) { last; } #end if chomp($pline); my @p_arr=split("\t",$pline); chomp($p_arr[0]); my @pID = split("r",$p_arr[0]); $p_arr[0] = $pID[1]; if($p_arr[1] > $r_arr[2]) { $rline=<$Reg>; redo; } #end if else { if($p_arr[0] == $r_arr[0] && $p_arr[1] >= $r_arr[1] && $p_arr[1] <= $r_arr[2]) { #NOTE: [0] element in each array now corresponds to chr number # r[1] is start of region and r[2] is end of region # p[1] is the position of the base pair shift(@p_arr); print ($Out "chr$r_arr[0]\t$r_arr[1]\t$r_arr[2]\t$r_arr[3]\t"); print $Out join ("\t", @p_arr), "\n"; #essentially I'm joining the two files with matching lines #w/ columns separated by tab } #end if } #end else } # end while <$Pos> } #end while <$Reg> close $Reg; close $Pos; close $Out; } sub RPSDemo { my $region = <<'__REGION__'; chr1 400 500 0 0 + chr1 600 700 0 0 + chr3 200 225 0 0 + chr4 650 700 0 0 + chr7 100 120 0 0 + chr7 300 400 0 0 + __REGION__ my $position = <<'__POSITION__'; chr1 415 0 0 + chr1 600 0 0 + chr3 205 0 0 + chr4 681 0 0 + chr7 110 0 0 + chr7 350 0 0 + __POSITION__ open my $Reg, '<', \$region; open my $Pos, '<', \$position; RegPosOut910992 ( $Reg, $Pos, \*STDOUT ); }