← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to t/PopGen/HtSNP.t

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/PopGen/HtSNP.t
 
1
# -*-Perl-*- Test Harness script for Bioperl
 
2
# $Id: HtSNP.t 15112 2008-12-08 18:12:38Z sendu $
 
3
 
 
4
use strict;
 
5
 
 
6
BEGIN {
 
7
    use lib '.';
 
8
    use Bio::Root::Test;
 
9
    
 
10
    test_begin(-tests => 8);
 
11
        
 
12
    use_ok('Bio::PopGen::HtSNP');
 
13
}
 
14
 
 
15
my $hap = [
 
16
     'acgt?cact',
 
17
     'acgt?ca-t',
 
18
     'cg?tag?gc',
 
19
     'cactcgtgc',
 
20
     'cgctcgtgc',
 
21
     'cggtag?gc',
 
22
     'ac?t?cact',
 
23
     ];
 
24
 
 
25
my $snp = [qw/s1 s2 s3 s4 s5 s6 s7 s8 s9/];
 
26
 
 
27
my $pop = [
 
28
     [qw/ uno    0.20/],
 
29
     [qw/ dos    0.20/],
 
30
     [qw/ tres   0.15/],
 
31
     [qw/ cuatro 0.15/],
 
32
     [qw/ cinco  0.10/],
 
33
     [qw/ seis   0.10/],
 
34
     [qw/ siete  0.10/],
 
35
       ];
 
36
 
 
37
my $obj = Bio::PopGen::HtSNP->new(-haplotype_block => $hap,
 
38
                                   -snp_ids         => $snp,
 
39
                                   -pattern_freq    => $pop,
 
40
);
 
41
 
 
42
 
 
43
# check lenght of the haplotype
 
44
is($obj->hap_length,9); # length of the haplotype must be 9 
 
45
 
 
46
# check silent SNPs
 
47
is( (join ' ', @{$obj->silent_snp}) ,'s4'); # the silent snp is in position 4 (counting from 1)
 
48
 
 
49
# check degenerated SNPs 
 
50
is( (join ' ', @{$obj->deg_snp}) ,'s7 s5 s3'); # degenerate SNPs 
 
51
 
 
52
# check useful SNP's
 
53
is( (join ' ', @{$obj->useful_snp}) ,'s1 s2 s6 s8 s9'); # degenerate SNPs 
 
54
 
 
55
# check the SNP code
 
56
is( (join ' ',@{$obj->snp_type_code}),'36 63 36 75 36'); # code for SNPs
 
57
 
 
58
# check the HtType 
 
59
is( (join ' ',@{$obj->ht_type}),'36 63 75'); # min snp_code 
 
60
 
 
61
my $tmp = $obj->deg_pattern();
 
62
my $err=0;
 
63
 
 
64
foreach my $family (keys %$tmp){
 
65
    if ($family eq '0'){
 
66
       unless ( (join ' ', @{$tmp->{$family}}) eq '0 6'){
 
67
           $err=1;
 
68
       }
 
69
    }
 
70
    if ($family eq '1'){
 
71
       unless ( (join ' ', @{$tmp->{$family}}) eq '1'){
 
72
           $err=1;
 
73
       }
 
74
    }
 
75
    if ($family eq '2'){
 
76
       unless ( (join ' ', @{$tmp->{$family}}) eq '2 4 5'){
 
77
           $err=1;
 
78
       }
 
79
    }
 
80
    if ($family eq '3'){
 
81
       unless ( (join ' ', @{$tmp->{$family}}) eq '3'){
 
82
           $err=1;
 
83
       }
 
84
    }
 
85
}
 
86
 
 
87
ok(! $err); # clustering degenerated haplotypes