#!/usr/bin/perl -w
use strict;
use Getopt::Std;
my $DEBUG;
my %opts;
### print_matrix
#
# Prints out a given matrix
#
# In:
# 1.: sequence string
# 2.: matrix array
#
# Out:
# /
#
#
sub print_matrix($@) {
my ($seq, @mat) = @_;
my ($seqlen) = length($seq);
my ($nt, $i, $j, $value);
### print sequence and indices in first row
# gibt folgendes aus:
# u a g c a u a g u c a g c u
# 1 2 3 4 5 6 7 8 9 10 11 12 13 14
#
printf "%3s%3s", " ", " "; # bestimmt die leerzeichen zwischen den Werten
for ($i=0; $i<$seqlen; $i++) { # $i=0 fängt mit dem 0ten Wert des Arrays an (also dem 1.)
# $i++ zählt aufwärts
printf "%3s", substr($seq, $i, 1);# gibt die Sequenz horizontal aus
}
printf "\n%3s%3s", " ", " "; # bestimmt die leerzeichen zwischen den Werten
for ($i=1; $i<=$seqlen; $i++) { # $i=1 fängt bei 1 an zu zählen
# $i++ zählt aufwärts
printf "%3s", $i; # gibt die Zahlen horizontal aus
}
print "\n";
### print matrix
#
for ($i=1; $i<=$seqlen; $i++) {
# print nt and index
# gibt folgendes aus:
# u 1
# a 2
# g 3
# c 4 usw
if ($i eq 0) {
$nt = " ";
} else {
$nt = substr($seq, $i-1, 1);
}
printf "%3s%3d", $nt, $i; # gibt Sequenz und Zahlen vertikal aus
# print matrix values
#
for ($j=1; $j<=$seqlen; $j++) {
if ($i eq $j) {
$value = "*"; # Diagonale durch die Matrix
} else {
$value = $mat[$i][$j];
}
printf "%3s", $value; # gibt die Werte in der Matrix aus
}
print "\n";
}
}
### debug
#
# print given message if global DEBUG is set to 1
#
# In:
# message to print
# Out:
# /
#
sub debug ($) {
if ($DEBUG) {
print "DEBUG: @_";
}
}
# end debug
### max
#
# Return maximum number of a list of numbers
# (Taken from Programming Perl Chapter 2.7)
#
# In:
# List of numbers (arbitrary length)
# Out:
# Maximum number
#
sub max (@) {
my ($max) = shift(@_); #Entfernt das 1. Element eines Arrays. Das 2. ist anschließend das 1. usw.
my $foo;
foreach $foo (@_) {
$max = $foo if $max < $foo;
}
return $max;
}
# end max
### basepair
#
# Decides whether two nt's can form a basepair, or not
#
# In:
# 1.: nt 1
# 2.: nt 2
# Out:
# 1, if a basepair can be formed
# 0, otherwise
#
sub basepair ($$) {
my ($nt1, $nt2) = @_;
my @valid_bp = ("gc", "au", "gu", "at", "gt"); # gültige Basenpaare
$nt1=lc($nt1); # lc = wandelt alle Zeichen in Kleinbuchstaben um
$nt2=lc($nt2); # lc = lower case
# "n" matches all
if ($nt1 eq "n" || $nt2 eq "n") { # eq = equal = gleich
return 1;
}
my $my_bp = $nt1 . $nt2;
foreach my $bp (@valid_bp) {
if ($my_bp eq $bp || $my_bp eq reverse($bp)) { # Das 1. Element wird durch das letzte, das zweite das
# vorletzte usw. vertauscht.
return 1;
}
}
return 0;
}
# end basepair
### usage
#
# print short help
#
sub usage () {
print "usage: ICH BIN NOCH NICHT VOLLSTAENDIG\n";
print " -h: print this help\n";
print " -d: enable debugging messages\n";
print " -s <sequence>\n";
}
# end usage
### main
# command line processing
getopts('dhs:', \%opts);
debug("kommando zeile gelesen\n");
# help
if ($opts{h}) {
usage();
exit 0;
}
# sequence
if (!$opts{s}) {
print "FEHLER: sequenz fehlt!\n";
usage();
exit 0;
}
# debugging
if ($opts{d}) {
$DEBUG=1;
}
my $seq = $opts{s}; # Deklaration des Skalars($) seq (Sequenz)
print "sequenz ist \"$seq\"\n"; # gibt die Sezqenz aus
my $seqlen = length($seq); # Deklaration des Skalars($) seqlen (Sequenzlänge)
print "sequenzlaenge ist $seqlen\n"; # gibt die Sezqenzlänge aus
my @dotplot; # Deklaration des Arrays(@) dotplot
# $dotplot[3][1]
# kann nukleotid 3 mit 1 ein basenpaar bilden?
for (my $i=1; $i<=$seqlen; $i++) {
#print "i ist jetzt $i\n";
for (my $j=1; $j<=$seqlen; $j++) {
#print "i:j = $i:$j\n";
# substr(STRING, START-1, LÄNGE);
# substr("hallo", 2, 3) -> llo
# substr("bioinformatik", 0, 7) -> bioinfo
my $nukl_i = substr($seq, $i-1, 1);
my $nukl_j = substr($seq, $j-1, 1);
if (basepair($nukl_i, $nukl_j)) {
# basenpaar möglich dann 1 speichern
$dotplot[$i][$j]=1;
} else {
$dotplot[$i][$j]=0;
}
#print "basenpaar zwischen nukleotid $i:$j = $nukl_i:$nukl_j möglich -> $dotplot[$i][$j]\n";
}
}
print "\n#########\nDOTPLOT\n##############\n";
print_matrix($seq, @dotplot);
##########################################
my @matrix;
my ($i, $j);
### Alles mit X'en initialisieren
#
for ($i=1; $i<=$seqlen; $i++) {
#print "i ist jetzt $i\n";
for ($j=1; $j<=$seqlen; $j++) {
#print "i:j = $i:$j\n";
$matrix[$i][$j]='X';
}
}
#print "\n#######\nMATRIX NACH INITIALISIERUNG MIT X\n########\n";
#print_matrix($seq, @matrix);
### Nebendiagonalen mit 0'en initialisieren
#
for ($i=0; $i<=$seqlen; $i++) {
#$matrix[$i][$i]=X; # alles außer der Diagonalen mit X belegt
if ($i>1) {
$matrix[$i][$i-1]=0; # 0 links von der Diagonale
}
if ($i+1<=$seqlen) {
$matrix[$i][$i+1]=0; # 1. 0 rechts von der Diagonale
}
if ($i+2<=$seqlen) {
$matrix[$i][$i+2]=0; # 2. 0 rechts von der Diagonale
}
if ($i+3<=$seqlen) {
$matrix[$i][$i+3]=0; # 3. 0 rechts von der Diagonale
}
}
print "\n######\nMATRIX NACH INITIALISIERUNG MIT X und 0\n##########\n";
print_matrix($seq, @matrix);
########################################
exit;
print "das folgende sind nur beispiele:\n";
debug("jetzt geht's los\n");
print "max(5,1,89,2) = ". max(5,1,89,2) . "\n";
print "basepair('a','u') = " . basepair('a','u') . "\n";
print "basepair('A','U') = " . basepair('A','U') . "\n";
print "basepair('a','c') = " . basepair('a','c') . "\n";
print "basepair('A','C') = " . basepair('A','C') . "\n";
debug("normales programm-ende erreicht\n");