binaries/src/ViennaRNA/interfaces/Perl/test.pl

   1 #!/usr/bin/perl -Iblib/arch -Iblib/lib
   2
   3 # Last changed Time-stamp: <2007-09-27 17:21:23 ivo>
   4
   5 ######################### We start with some black magic to print on failure.
   6 # (It may become useful if the test is moved to ./t subdirectory.)
   7 use strict;
   8 use Test;
   9 use lib qw|blib/arch blib/lib|;
  10
  11 BEGIN { plan tests => 24; }
  12
  13 use RNA;
  14 use warnings;
  15
  16 ######################### End of black magic.
  17
  18 # Insert your test code below (better if it prints "ok 13"
  19 # (correspondingly "not ok 13") depending on the success of chunk 13
  20 # of the test code):
  21
  22
  23 my $seq1  ="CGCAGGGAUACCCGCG";
  24 my $struc1="(((.(((...))))))";
  25 my $seq2  ="GCGCCCAUAGGGACGC";
  26 my $struc2="((((((...))).)))";
  27 # calculate a hamming distance (from util.c)
  28 ok(RNA::hamming($seq1, $seq2), 16);
  29
  30 # check a global variable
  31 ok($RNA::temperature, 37);
  32
  33 # fold a sequence
  34
  35 # old obsolete way of calling fold()
  36 my $struct = $seq1;  # wierd way of allocating space
  37 my $mfe=RNA::fold($seq1, $struct);
  38 ok($struct, $struc1);
  39
  40 # new better interface
  41 ($struct, $mfe) = RNA::fold($seq1);
  42 ok($struct eq $struc1);
  43 # check energy
  44 ok(RNA::energy_of_struct($seq1,$struc1), $mfe);
  45
  46 # check constrained folding
  47 $RNA::fold_constrained = 1;
  48 my($struct3, $cmfe) = RNA::fold($seq1, '....xx....xx...');
  49 ok($struct3, '(((..........)))');
  50 ok(RNA::energy_of_struct($seq1,$struct3), $cmfe);
  51 $RNA::fold_constrained = 0;
  52
  53 # test cofold
  54 $RNA::cut_point = length($seq1)+1;
  55 my($costruct, $comfe) = RNA::cofold($seq1 . $seq2);
  56 ok($costruct, '(((.(((...))))))((((((...))).)))');
  57 $cmfe = RNA::energy_of_struct($seq1 . $seq2, $costruct);
  58 ok(abs($comfe-$cmfe)<1e-5);
  59 my ($x,$ac,$bc,$fcab,$cf) = RNA::co_pf_fold($seq1. $seq2, $struct);
  60 ok(($cf<$comfe)&&($comfe-$cf<1.3));
  61 #test concentration computation
  62 my $fcaa;
  63 my $fcbb;
  64 my ($usel1,$usel2, $usel3);
  65 ($x,$usel1, $usel2, $fcaa, $usel3)= RNA::co_pf_fold($seq1. $seq1, $struct);
  66 $RNA::cut_point = length($seq2)+1;
  67 ($x,$usel1, $usel2, $fcbb, $usel3)= RNA::co_pf_fold($seq2. $seq2, $struct);
  68 my ($AB,$AA,$BB,$A,$B)=RNA::get_concentrations($fcab, $fcaa, $fcbb,$ac, $bc, 1e-5, 1e-5);
  69 $AB/=2e-5;
  70 $AA/=2e-5;
  71 $BB/=2e-5;
  72 $A/=2e-5;
  73 $B/=2e-5;
  74 ok((abs($AB-0.0)+abs($AA-0.00578)+abs($BB-0.01100)+abs($A-0.48843)+abs($B-0.47801))<0.0001);
  75 $RNA::cut_point=-1;
  76
  77 # pf_fold
  78 my $f = RNA::pf_fold($seq1, $struct);
  79 ok(($f<$mfe)&&($mfe-$f<0.8));
  80
  81 # tree distance
  82 my $xstruc = RNA::expand_Full($struc1);
  83 my $T1 = RNA::make_tree($xstruc);
  84 $xstruc = RNA::expand_Full($struc2);
  85 my $T2 = RNA::make_tree($xstruc);
  86 $RNA::edit_backtrack = 1;
  87 my $tree_dist = RNA::tree_edit_distance($T1, $T2);
  88 # print RNA::get_aligned_line(0), RNA::get_aligned_line(1),"\n";
  89 ok($tree_dist,2);
  90
  91 # check access to a C array
  92 #ok(RNA::ptrvalue($RNA::iindx,3),108);
  93 ok(RNA::intP_getitem($RNA::iindx,3),108);
  94
  95 # memmove does not work in current swig versions
  96 # RNA::memmove($RNA::xsubi, pack('S3', 171,42,93));
  97 # use shortP_setitem instead
  98 RNA::ushortP_setitem($RNA::xsubi, 0, 171);
  99 RNA::ushortP_setitem($RNA::xsubi, 1, 42);
 100 RNA::ushortP_setitem($RNA::xsubi, 2, 93);
 101 ok(RNA::cdata($RNA::xsubi, 6),pack('S3', 171,42,93));
 102
 103 # get a bp prob in two different ways
 104 my $p1 = RNA::get_pr(2,15);
 105 my $ii = RNA::intP_getitem($RNA::iindx, 2);
 106 my $p2 = RNA::doubleP_getitem($RNA::pr, $ii-15);
 107 ok(($p1<0.999) && ($p1>0.99) && (abs($p1-$p2)<1.2e-7));
 108
 109 my $bpf = RNA::Make_bp_profile(length($seq1));
 110 my @bpf = unpack("f*",RNA::cdata($bpf, length($seq1)*4*3));
 111 ok (($bpf[2*3]+$bpf[2*3+1]>.99999)&&$bpf[2*3+2]==0 &&
 112     ($bpf[2*3+1]>=$p1));
 113
 114 my $pack = RNA::pack_structure($struc1);
 115 ok (RNA::unpack_structure($pack), $struc1);
 116
 117
 118 RNA::parse_structure($struc1);
 119 ok(($RNA::loops==2) && ($RNA::pairs==6)&&($RNA::unpaired==4) &&
 120   (RNA::intP_getitem($RNA::loop_degree,1)==2));
 121
 122
 123 RNA::PS_rna_plot($seq1, $struc1, "test_ss.ps");
 124 my $anote = "2 15 1 gmark\n" . "3 cmark\n";
 125 RNA::PS_rna_plot_a($seq1, $struc1, "test_ss_a.ps", undef, $anote);
 126 RNA::PS_dot_plot($seq1, "test_dp.ps");
 127 RNA::ssv_rna_plot($seq1, $struct, "test.coord");
 128 # print "$seq1, $struct, $mfe, $f\n";
 129 print "please check the two postscript files test_ss.ps and test_dp.ps\n";
 130 RNA::write_parameter_file("test.par");
 131
 132 $RNA::symbolset = "GC";
 133 my $start = RNA::random_string(length $struc1, "GC");
 134 my ($sinv, $cost) = RNA::inverse_fold($start, $struc1);
 135 my ($ss, $en) = RNA::fold($sinv);
 136 ok($ss, $struc1);
 137
 138 RNA::free_pf_arrays();
 139 RNA::free_arrays();
 140 RNA::free_co_arrays();
 141
 142 $RNA::subopt_sorted = 1;
 143 $RNA::noLonelyPairs = 1;
 144 my $solution = RNA::subopt($seq1, undef, 500, undef);
 145
 146 printf "%d suboptimals\n", $solution->size();
 147 for (0..$solution->size()) {
 148   # the last access should produce a "value out of range" warning
 149   printf "%s %6.2f\n",  $solution->get($_)->{structure},
 150                         $solution->get($_)->{energy}
 151         if defined  $solution->get($_)->{structure};
 152 }
 153 $RNA::cut_point = 3;
 154 my $e =  RNA::energy_of_struct("GCGC", "(())");
 155 ok(int($e*100+0.5), 70);
 156
 157 my $duplex = RNA::duplexfold($seq1, $seq2);
 158
 159 ok($duplex->{structure}, "(.(.(((.....(((.&))))))...).).");
 160 undef $duplex;
 161
 162 my @align = ("GCCAUCCGAGGGAAAGGUU", "GAUCGACAGCGUCU-AUCG", "CCGUCUUUAUGAGUCCGGC");
 163 my ($css, $cen) = RNA::alifold(\@align);
 164 ok($css,"(((.(((...)))..))).");
 165 ok(RNA::consens_mis(\@align), "SMBHBHYDRBGDVWmVKBB");
 166 RNA::free_alifold_arrays();