1#!/usr/bin/perl -I.libs 2 3######################### We start with some black magic to print on failure. 4# (It may become useful if the test is moved to ./t subdirectory.) 5use strict; 6use Test::More tests => 8; 7 8use RNA; 9use warnings; 10use RNAHelpers qw(:Paths); 11 12 13my $datadir = getDataDirPath(); 14 15my $seq_con = "CCCAAAAGGGCCCAAAAGGG"; 16my $str_con = "..........(((....)))"; 17my $str_con_def = "(((....)))(((....)))"; 18my $seq_long = "AUUUCCACUAGAGAAGGUCUAGAGUGUUUGUCGUUUGUCAGAAGUCCCUAUUCCAGGUACGAACACGGUGGAUAUGUUCGACGACAGGAUCGGCGCACUACGUUGGUAUCAUGUCCUCCGUCCUAACAAUUAUACAUCGAGAGGCAAAAUUUCUAAUCCGGGGUCAGUGAGCAUUGCCAUUUUAUAACUCGUGAUCUCUC"; 19my $fc; #fold compound reference 20my $ss=""; #return string 21my $mfe=0; 22my $energy=0; 23 24 25sub mfe_window_callback { 26 27 my ($start, $end, $structure, $energy, $data) = @_; 28 my %Lfold_hit = (); 29 $Lfold_hit{'structure'} = $structure; 30 $Lfold_hit{'start'} = $start; 31 $Lfold_hit{'end'} = $end; 32 $Lfold_hit{'energy'} = $energy; 33 34 push @{$data}, \%Lfold_hit; 35} 36 37 38################################## 39## test_constraints_add 40################################## 41 42my $hc_file = $datadir . "hc.txt"; 43print "test_constraints_add"; 44$fc = new RNA::fold_compound($seq_con); 45$fc->constraints_add($hc_file); 46($ss,$mfe) = $fc->mfe(); 47printf("%s [%6.2f] \n",$ss,$mfe); 48is($ss,$str_con); 49 50$fc->hc_init(); 51($ss,$mfe) = $fc->mfe(); 52printf("%s [%6.2f] \n",$ss,$mfe); 53is($ss,$str_con_def); 54 55################################## 56#sc.txt = E 3 8 1 -5 57################################## 58my $sc_file = $datadir . "sc.txt"; 59$fc->sc_init(); 60$fc->constraints_add($sc_file); 61($ss,my $mfeNew) = $fc->mfe(); 62printf("%s [%6.2f] \n",$ss,$mfeNew); 63is(sprintf ("%6.2f",$mfe), sprintf ("%6.2f",$mfeNew+5)); 64 65################################## 66##test_hc_add_up: 67################################## 68print "test_hc_add_up\n"; 69 70$fc = new RNA::fold_compound($seq_con); 71$fc->hc_add_up(1,RNA::CONSTRAINT_CONTEXT_ALL_LOOPS); 72($ss,$mfe) = $fc->mfe(); 73printf("%s [%6.2f] \n",$ss,$mfe); 74is($ss,".((....)).(((....)))"); 75 76################################## 77## test_hc_add_bp_nonspecific 78################################## 79print "test_hc_add_bp_nonspecific"; 80 81$fc= new RNA::fold_compound("GGGCCCCCCCCCCCCCCCCC"); 82$fc->hc_add_bp_nonspecific(20,-1); # force the last base to pair with some bases upstream 83($ss,$mfe) = $fc->mfe(); 84printf("%s [%6.2f] \n",$ss,$mfe); 85is($ss,"(((..............)))"); 86 87################################## 88## test_hc_add_bp 89################################## 90print "test_hc_add_bp"; 91 92$fc= new RNA::fold_compound($seq_con); 93$fc->hc_add_bp(1,20,RNA::CONSTRAINT_CONTEXT_ENFORCE | RNA::CONSTRAINT_CONTEXT_ALL_LOOPS); 94($ss,$mfe) = $fc->mfe(); 95printf("%s [%6.2f] \n",$ss,$mfe); 96is($ss,"(((..............)))"); 97 98################################## 99## test_hc_add_from_db 100################################## 101print "test_hc_add_from_db"; 102 103$fc = new RNA::fold_compound($seq_con); 104$fc->hc_add_from_db("xxx................."); 105($ss,$mfe) = $fc->mfe(); 106printf("%s [%6.2f] \n",$ss,$mfe); 107is($ss,$str_con); 108 109################################## 110## test_hc_mfe_window (base pairs) 111################################## 112print "test hc_mfe_window_bp\n"; 113 114$fc = new RNA::fold_compound($seq_long, undef, RNA::OPTION_WINDOW); 115$fc->hc_add_bp(1, 10, RNA::CONSTRAINT_CONTEXT_ALL_LOOPS | RNA::CONSTRAINT_CONTEXT_ENFORCE); 116$fc->hc_add_bp(101, 110, RNA::CONSTRAINT_CONTEXT_ALL_LOOPS | RNA::CONSTRAINT_CONTEXT_ENFORCE); 117my @data = (); 118$mfe = $fc->mfe_window_cb(\&mfe_window_callback, \@data); 119 120my $everythingFine = 1; 121foreach my $hit (@data) { 122 if (($hit->{'start'} <= 101) && ($hit->{'end'} >= 110)) { 123 # must contain base pair (101,110) 124 my $pt = RNA::ptable($hit->{'structure'}); 125 $everythingFine = 0 if $pt->[101 - $hit->{'start'} + 1] != (110 - $hit->{'start'} + 1); 126 } 127 if (($hit->{'start'} == 1) && ($hit->{'end'} >= 10)) { 128 # must contain base pair (101,110) 129 # must contain base pair (101,110) 130 my $pt = RNA::ptable($hit->{'structure'}); 131 $everythingFine = 0 if $pt->[1] != 10; 132 } 133} 134 135ok($everythingFine == 1); 136 137undef $fc; 138