#!/usr/bin/perl use strict; use warnings; my $file1 = $ARGV[0]; my $outfile = $ARGV[1]; open (my $FH, '<', $file1) or die "Could not open $file1: $!"; open (my $outfh, '>>', $outfile) or die "Could not write to $outfile: $!"; my @lines = <$FH>; my @seqs; my @names; my @reds; my $len; my %loci; for (my $x = 0; $x < @lines; ++$x){ if ($lines[$x] =~ m/^>(.*)$/){ my $taxon = $1; push (@names, $taxon); $loci{$taxon} = ''; my $y = 1; while (1){ if ($x+$y == @lines or $lines[$x+$y] =~ m/^>/){ last; } else { chomp $lines[$x+$y]; $loci{$taxon} .= $lines[$x+$y]; ++$y; } } } } foreach my $name (@names){ my @pos = split //, $loci{$name}; my $row1 = $name; my $row2 = $name; foreach my $p (@pos){ if ($p eq 'A'){ $row1 .= " 1"; $row2 .= " 1"; } if ($p eq 'C'){ $row1 .= " 2"; $row2 .= " 2"; } if ($p eq 'G'){ $row1 .= " 3"; $row2 .= " 3"; } if ($p eq 'T'){ $row1 .= " 4"; $row2 .= " 4"; } if ($p eq 'R'){ $row1 .= " 1"; $row2 .= " 3"; } if ($p eq 'Y'){ $row1 .= " 2"; $row2 .= " 4"; } if ($p eq 'W'){ $row1 .= " 1"; $row2 .= " 4"; } if ($p eq 'S'){ $row1 .= " 2"; $row2 .= " 3"; } if ($p eq 'M'){ $row1 .= " 1"; $row2 .= " 2"; } if ($p eq 'K'){ $row1 .= " 3"; $row2 .= " 4"; } if ($p eq '-'){ $row1 .= " -1"; $row2 .= " -1"; } } print {$outfh} $row1, "\n"; print {$outfh} $row2, "\n"; }