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