Rohaq fucked around with this message at 10:45 on Oct 10, 2012

homercles fucked around with this message at 21:16 on Oct 21, 2012

blah1, blah2, thingiwant1, blah3, thingiwant2, thingiwant3
thingiwant1, thingiwant2, thingiwant3

my $re_longline_match = '^(?:[^,]+, ){2}(?<group1>[^,]+), [^,]+, (?<group2>[^,]+), (?<group3>.+)$';
my $re_shortline_match = '^(?<group1>[^,]+), (?<group2>[^,]+), (?<group3>[^,]+)$';
while (<STDIN>) {
  if ( $_ =~ /$re_longline_match/ || $_ =~ /$re_shortline_match/ ) {
    print 'Group 1: ', $+{group1}, "\n";
    print 'Group 2: ', $+{group2}, "\n";
    print 'Group 3: ', $+{group3}, "\n\n";
  }
}

Rohaq fucked around with this message at 03:20 on Oct 22, 2012

if ( exists $map_blah{$extracted_data} ) {
  $extracted_data = $map_blah{$extracted_data};
} else {
  warn "No mapping for blah: '$extracted_data'.\n";
}

Rohaq fucked around with this message at 10:43 on Oct 23, 2012

use Test::Base;
use Text::Levenshtein::Damerau;

plan tests => 1 * blocks;
my $tld = Text::Levenshtein::Damerau->new('four');

run {
	my @input = $block->input;
	# print $input[0] prints four

	my @expected = $block->expected
	# print $expected[0] prints 0

	my $hashref_of_both = ...# Might be pushing it here due to ordering?
	# print $hash_of_both->{'four'}; prints 0
	# print $hash_of_both->{'fuor'}; prints 1
	# print $hash_of_both->{'fourteen'}; prints 4

	is( $tld->dld({ list => \@input }), $hashref_of_both )
}

__END__

=== test matching
--- input
four,fuor,fourteen	# See below comment
--- expected
0,1,4	# This will be passed as a scalar naturally, 
	# but I want to pass it as a list

use Test::More tests => 8;
use Text::Levenshtein::Damerau;

my $tld = Text::Levenshtein::Damerau->new('four');

#Test scalar argument
cmp_ok( $tld->dld('four'),	'==', 0, 'test helper matching');
cmp_ok( $tld->dld('for'), 	'==', 1, 'test helper insertion');
cmp_ok( $tld->dld('fourth'),'==', 2, 'test helper deletion');
cmp_ok( $tld->dld('fuor'), 	'==', 1, 'test helper transposition');
cmp_ok( $tld->dld('fxxr'), 	'==', 2, 'test helper substitution');
cmp_ok( $tld->dld('FOuR'), 	'==', 3, 'test helper case');
cmp_ok( $tld->dld(''), 	'==', 4, 'test helper empty');


#Test array reference argument
my @list = ('four','fourty','fourteen','');
is_deeply($tld->dld({ list => \@list }), { four => 0, fourty => 2, fourteen => 4, '', => 4 }, 'test dld(\@array_ref)');

uG fucked around with this message at 01:18 on Oct 25, 2012

+#!/usr/bin/perl
+use warnings;
+use strict;
+
+my $file_in = $ARGV[0];
+my $key;
+my $direction = "Forward";
+my $rdirection = "Reverse";
+my %fasta_hash ;
+
+open ( FASTA_IN , "<" , $file_in) || die $!;
+open ( OUT , ">", "output.txt") || die $!;
+## parse fasta file into a hash ##
+while ( my $line = <FASTA_IN>){
+    chomp $line;
+	if ($line =~/^>/){
+		$key = $line;
+		}
+
+	else{
+	$fasta_hash{$key} .= uc($line);	
+	chomp $line;
+		}
+    }
+
+close (FASTA_IN);
+my @scaffolds = keys %fasta_hash;
+
+foreach (@scaffolds){
+    get_ORFs_of_210_nt($_,$fasta_hash{$_},$direction);				
+	get_rORFs_of_210_nt($_,$fasta_hash{$_},$rdirection);
+	}
+	
+exit;
+ 
+sub get_ORFs_of_210_nt{
+	my $header = $_[0];
+	my $seq = $_[1];
+	my $dir = $_[2];
+	my @fstarts;
+	my @fstops;
+	my $codon;
+	my @frame1starts;
+	my @frame2starts;
+	my @frame3starts;
+	my @frame1stops;
+	my @frame2stops;
+	my @frame3stops;
+	my $length1;
+	my $start1;
+	my $stop1;
+	my $length2;
+	my $start2;
+	my $stop2;
+	my $length3;
+	my $start3;
+	my $stop3;
+	
+	while ($seq =~/ATG/ig){
+        push (@fstarts , pos ($seq)-3);
+	}
+    while ($seq =~/TAG|TAA|N|TGA/ig){
+        push (@fstops , pos ($seq));								
+    }   
+    while (@fstarts){
+        my $codon = shift @fstarts;
+        if ($codon%3 == 0){												
+            push @frame1starts, $codon;
+            }
+        elsif ($codon%3==1){
+            push @frame2starts, $codon;
+            }
+        elsif ($codon%3==2){
+            push @frame3starts, $codon;
+            }
+        else {
+            die "Illegal Modulus Return";
+            }
+        }  
+	while (@fstops){
+		my $codon = shift @fstops;
+		if ($codon%3 == 0){
+            push @frame1stops, $codon-1;
+            }
+        elsif ($codon%3==1){
+            push @frame2stops, $codon-1;
+            }
+        elsif ($codon%3==2){
+            push @frame3stops, $codon-1;
+            }
+        else {
+            die "Illegal Modulus Return";
+            }
+        }
#####This is the problem section ##########
+	foreach (@frame1starts){
+		$start1 = shift(@frame1starts);
+		$stop1 = shift (@frame1stops);
+		$length1 = ($stop1-$start1)+1;
+		if ($start1 < $stop1){
+			if(($length1) >= 210){
+				print OUT "Frame 1:  ",$header," Direction: ",$dir,"\n";
+				my $substring = substr($seq,$start1,$length1);
+				print OUT "   ",$substring."\n";
+				$start1 = shift(@frame1starts);
+                               $stop1 = shift(@frame1stops);
+			}
+			elsif(($length1) < 210 && ($length1) > 0){
+				$stop1 = shift(@frame1stops);
+			}
+		}
+		else{
+			$stop1=shift(@frame1stops);
+		}
+	}
######## Below this is the same procedure as above, for next frame #######
+	foreach (@frame2starts){
+		$start2 = shift(@frame2starts);
+		$stop2 = shift (@frame2stops);
+		$length2 = ($stop2-$start2)+1;
+		if ($start2 < $stop2){
+			if(($length2) >= 210){
+				print OUT "Frame 2:  ",$header," Direction: ",$dir,"\n";
+				my $substring = substr($seq,$start2,$length2);
+				print OUT "   ",$substring."\n";
+				$stop2 = shift(@frame2stops);
+			}
+			elsif(($length2) < 210 && ($length2) > 0){
+				$stop2 = shift(@frame2stops);
+			}
+		}
+		else{
+			$stop2=shift(@frame2stops);
+		}
+	}
+	foreach (@frame3starts){
+		$start3 = shift(@frame3starts);
+		$stop3 = shift (@frame3stops);
+		$length3 = ($stop3-$start3)+1;
+		if ($start3 < $stop3){
+			if(($length3) >= 210){
+				print OUT "Frame 3:  ",$header," Direction: ",$dir,"\n";
+				my $substring = substr($seq,$start3,$length3);
+				print OUT "   ",$substring."\n";
+				$stop3 = shift(@frame3stops);
+			}
+			elsif(($length3) < 210 && ($length3) > 0){
+				$stop3 = shift(@frame3stops);
+			}
+		}
+		else{
+			$stop3=shift(@frame3stops);
+		}
+	}
+}
+
########this is the 2nd sub called, almost exactly identical except #######
########the sequence read in is reversed and translated to the complement #######

+sub get_rORFs_of_210_nt{
+	my $rheader = $_[0];
+	my $rseq = $_[1];
+	my $rdir = $_[2];
+	my @rfstarts;
+	my @rfstops;
+	my $rcodon;
+	my @rframe1starts;
+	my @rframe2starts;
+	my @rframe3starts;
+	my @rframe1stops;
+	my @rframe2stops;
+	my @rframe3stops;
+	my $rlength1;
+	my $rstart1;
+	my $rstop1;
+	my $rlength2;
+	my $rstart2;
+	my $rstop2;
+	my $rlength3;
+	my $rstart3;
+	my $rstop3;
+	
+	$rseq = reverse($rseq);
+	$rseq = ~tr/ATGCatgc/TACGtagc/;
#####the rest is the same as the first sub######

• The starts and stops for each frame are put into corresponding arrays
  
• The first start and stop needs to be shifted into a scalar of some sort - this is the first spot I have trouble with
  
• If the start is before the stop and at least 210 base pairs away, then it is printed along with the substring - this works fine.
  
• BOTH the start and stop are shifted, and the loop should start over
  
• If the start is prior to the stop, but less than 210 away, only the stop should shift, then start loop again
  
• If the start is after the stop, shift the stop and re-loop as before
  

uG fucked around with this message at 01:24 on Oct 30, 2012

my @x = (1,2,3,4,5,6);

foreach (@x) {
    my $y = shift @x;
    print $y."\n";
}
#Output:
#1
#2
#3

my @x = (1,2,3,4,5,6);
my @y = (7,8,9,10,11,12);

while (my $start1 = shift @x) {
    my $stop1 = shift @y;
    print "start: $start1 end: $stop1\n";
}
#Output:
#start: 1 end: 7
#start: 2 end: 8
#start: 3 end: 9
#start: 4 end: 10
#start: 5 end: 11
#start: 6 end: 12

The Gripper fucked around with this message at 01:52 on Oct 30, 2012