Perl example code

These are code examples that accompany the MBV3070 Perl lectures.

Copy and paste the text to a text file called Excercise1.plx And then, in the command prompt, type

perl Excercise1.plx

Excercise1.plx

#!/usr/bin/perl
use strict;
use warnings;

print "My first Perl program\n";
#try single quotes
print "First line\nsecond line and there is a tab\there\n";

Excercise2.plx

#!/usr/bin/perl
use strict;
use warnings;

#assign values to variables $x and $y and print them out
my $x = 4;
my $y = 2;
print "x is $x and y is $y\n";

#example of arithmetic expression
my $z = $x + $y**3;
$x++;
print "x is $x and z is $z\n";

#evaluating arithmetic expression within print command
print "add 3 to $z: $z + 3\n"; #did it work?
print "add 3 to $z:", $z + 3,"\n";

Excercise3.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Concatenate two given sequences, 
#find the length of the new sequence and
#print out the second codon of the sequence

#assign strings to variables
my $DNA = "GATTACACAT";
my $polyA = "AAAA";

#concatenate two strings
my $modifiedDNA = $DNA.$polyA;

#calculate the length of $modifiedDNA and
#print out the value of the variable and its length
my $DNAlength = length($modifiedDNA);
print "Modified DNA: $modifiedDNA has length $DNAlength\n";

#extract the second codon in $modifiedDNA
my $codon = substr($modifiedDNA,3,3);
print "Second codon is $codon\n";

Excercise4.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Ask the user for her name and age
#and calculate her age in days
#get a string from the keyboard
print "Please enter your name\n";
my $name = <STDIN>;
#getting rid of the new line character
#try leaving this line out
chomp($name); 
#prompt the user for his/her age
#get a number from the keyboard
print "$name please enter your age\n";
my $age = <>;
chomp($age);
#calculate age in days
my $age_in_days = $age*365;
print "You are $age_in_days days old\n";

Excercise5.plx

#!/usr/bin/perl
use strict;
use warnings;

#initialize an array
my @bases = ("A","C","G","T");

#print two elements of the array
print $bases[0],$bases[2],"\n";

#print the whole array
print @bases,"\n"; #try with double quotes

#print the number of elements in the array
print scalar(@bases),"\n";

Excercise6.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Count the frequency of base G
#in a given DNA sequence

my $DNA = "GATTACACAT";

#initialize $countG and $currentPos
my $countG = 0;
my $currentPos = 0;

#calculate the length of $DNA
my $DNAlength = length($DNA);

#for each letter in the sequence check if it is the base G
#if 'yes' increment $countG
while($currentPos < $DNAlength){
	my $base = substr($DNA,$currentPos,1);
	if($base eq "G"){
		$countG++;
	}
	$currentPos++;
} #end of while loop

#print out the number of Gs
print "There are $countG G bases\n";

Excercise7.plx

#!/usr/bin/perl
use strict;
use warnings;
my @array;
#initialize a 20-element array with numbers 0,...19
for(my $i=0;$i<20;$i++){
	$array[$i] = $i;
}

#print elements one-by-one using foreach
foreach my $element (@array){
	print "$element\n";
}

Excercise8.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: For a given DNA sequence find its RNA transcript,
#find its reverse complement and check if
#the reverse complement contains a start codon

my $DNA = "GATTACACAT";

#transcribe DNA to RNA - T changes to U
my $RNA = $DNA;
$RNA =~ s/T/U/g;
print "RNA sequence is $RNA\n";

#find the reverse complement of $DNA using substitution operator
#first - reverse the sequence
my $rcDNA = reverse($DNA);

$rcDNA =~ s/T/A/g;
$rcDNA =~ s/A/T/g;
$rcDNA =~ s/G/C/g;
$rcDNA =~ s/C/G/g;

print "Reverse complement of $DNA is $rcDNA\n"; #did it work?

#find the reverse complement of $DNA using translation operator
#first - reverse the sequence
$rcDNA = reverse($DNA);
#then - complement the sequence
$rcDNA =~ tr/ACGT/TGCA/;
#then - print the reverse complement
print "Reverse complement of $DNA is $rcDNA\n";

#look for a start codon in the reverse sequence
if($rcDNA =~ /ATG/){
	print "Start codon found\n";
}
else{
	print "Start codon not found\n";
}

Excercise9.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Make a subroutine that calculates
#the reverse
#complement of a DNA sequence and call it
#from the main program 

#body of the main program with the function call
my $DNA = "GATTACACAT";
my $rcDNA = revcomp($DNA); 
print "$rcDNA\n";
exit;
#definition of the function for reverse complement
sub revcomp{
	my($DNAin) = @_;
	my $DNAout  = reverse($DNAin);
	$DNAout =~ tr/ACGT/TGCA/;
	return $DNAout;
}

Excercise10.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Read DNA sequences from ‘DNAseq’ input file – 
#there is one sequence per line
#For each sequence find the reverse complement and 
#print it to ‘DNAseqRC’ output file

#open input and output files
open(IN,"DNAseq.txt");
open(OUT,">DNAseqRC.txt");

#read the input file line-by-line
#for each line find the reverse complement
#print it in the output file
while(<IN>){
	chomp;
	my $rcDNA = revcomp($_);
	print OUT "$rcDNA\n";
}

#close input and output files
close(IN);
close(OUT);
exit();


#definition of the function for reverse complement
sub revcomp{
	my($DNAin) = @_;
	my $DNAout = reverse($DNAin);
	$DNAout =~ tr/ACGT/TGCA/;
	return $DNAout;
}

DNAseq.txt

ACGACTAGCATCAGCAT
AAAAATGATCGACTATATAGCATA
AAAGGTGCATCAGCATGG

Excercise11.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Print a list of all Perl programs we did so far.
#These files can be found in your current directory and 
#they start with the word ‘program’

print "List of programs we made today:\n";

#system call for 'ls' function - the result goes into a string
my $listing = `dir`; #these are back quotes

#split the string to get individual files
my @files = split(/\n/,$listing);

#use foreach to step through the array
#if a file contains word 'program' print it out

foreach my $file (@files){
	if($file =~ /excercise/){
		print "$file\n";
	}
}

Excercise12.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Write a program that has one function.
#Use a variable named “$some_variable” in this
#function and in the main body of the program.

#Prove that you can alter the value of 
#$some_variable in the function without
#changing the value of $some_variable in the 
#the main body of the program

#declare variables used in the main routine 
my $some_variable;
my $some_variable_changed_by_subroutine;

#main routine
$some_variable = 10;

print "i am in the main routine and some_variable is: $some_variable\n";
$some_variable_changed_by_subroutine = subroutine($some_variable);
print "i am in the main routine some_variable is now: $some_variable\n";
print "i am in the main routine some_variable_changed_by_subroutine is: $some_variable_changed_by_subroutine\n";



#a subroutine that uses a variable with the same name as a variable in the main routine
sub subroutine{
    my $some_variable;
	
	$some_variable = $_[0];
	
	print "i am in the subroutine and some_variable is: $some_variable\n";
	
	++$some_variable;
	
	print "i am in the subroutine and some_variable is now: $some_variable\n";
	
	return $some_variable
}

Excercise13.plx

#!/usr/bin/perl
use strict;
use warnings;

#TASK: Read lines from input file – 
#print lines that match a regular expression

#open input and output files
open(IN,"excercise13input.txt");
open(OUT,">excercise13output.txt");

#read the input file line-by-line
#for each line ask if it matches the regex
#print it in the output file
while(<IN>){
	chomp;
	if ($_ =~ /^ATG?C*[ATCG]+?A{3,10}$/) {
		print OUT "$_\n";
		print "$_\n";
	}
}

#close input and output files
close(IN);
close(OUT);
exit();

excercise13input.txt

#this is the regex that we are looking for in the lines below
#/^ATG?C*[ATCG]+?A{3,10}$/



ATGCCCAA
ATGCCCAAAA
ATGCCCAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD