t/unit_fixture/CXGN/Genotype.t

   1
   2 use strict;
   3 use Test::More;
   4 use Data::Dumper;
   5 use JSON;
   6
   7 use lib 't/lib';
   8 use SGN::Test::Fixture;
   9
  10 use Storable 'dclone'; # create deep copy of a hash
  11
  12 use CXGN::Genotype;
  13
  14 my $f = SGN::Test::Fixture->new();
  15
  16 $f->get_db_stats();
  17
  18 my $schema = $f->bcs_schema();
  19
  20 my $gt1 = CXGN::Genotype->new( { genotypeprop_id=> 1708, bcs_schema=>$schema});
  21
  22 my $gt2 = CXGN::Genotype->new( { genotypeprop_id=> 1709, bcs_schema=>$schema});
  23
  24 my $dist2 = $gt1->calculate_distance($gt1);
  25
  26 print STDERR "Self distance is $dist2\n";
  27
  28
  29
  30 my $gt1_markers = $gt1->markerscores();
  31
  32
  33
  34 my $gt3_markers = dclone($gt1_markers);
  35
  36 print STDERR "BEFORE GT3 MARKERS=".Dumper(\%$gt3_markers);
  37
  38 my $zeroes;
  39 my $ones;
  40 my $twos;
  41 my $undefs;
  42
  43 foreach my $m (keys(%$gt3_markers)) {
  44     print STDERR "Changing marker $m ... ".$gt3_markers->{$m}->{DS}."\n";
  45     if ($gt3_markers->{$m}->{DS} == 0) {
  46         $gt3_markers->{$m}->{DS} = 2;
  47         $zeroes++;
  48     }
  49     elsif ($gt3_markers->{$m}->{DS} == 1) {
  50         $gt3_markers->{$m}->{DS} = 2;
  51         $ones++;
  52     }
  53     elsif ($gt3_markers->{$m}->{DS} == 2) {
  54         $gt3_markers->{$m}->{DS} = 0;
  55         $twos++;
  56     }
  57     elsif ($gt3_markers->{$m}->{DS} == undef) {
  58         $gt3_markers->{$m}->{DS} = 1;
  59         $undefs++;
  60     }
  61     print STDERR "Changed marker $m ... ".$gt3_markers->{$m}->{DS}."\n";
  62 }
  63
  64
  65 print STDERR "0s: $zeroes. 1s: $ones. 2s: $twos. undef: $undefs\n";
  66
  67 print STDERR "AFTER GT3 MARKERS=".Dumper(\%$gt3_markers);
  68 my $gt3 = CXGN::Genotype->new();
  69 $gt3->markerscores($gt3_markers);
  70
  71 # if (!is_deeply($gt3_markers, $gt1_markers)) {
  72 #     print STDERR "They are not the same!\n";
  73 # }
  74
  75 my $dist3 = $gt1->calculate_distance($gt3);
  76 print STDERR "Distance with changes: $dist3\n";
  77 is($dist3, 0);
  78
  79 my $dist = $gt1->calculate_distance($gt2);
  80 print STDERR  "The distance is $dist\n";
  81 is($dist, 0.444);
  82
  83 #print STDERR join(",", @{$gt1->markers});
  84
  85 my $rs = $schema->resultset("Genetic::Genotypeprop")->search( { genotypeprop_id=> { -in => [ 1708, 1709 ] } });
  86
  87 my @gt;
  88
  89 @gt = map { $_->value } $rs->all();
  90 #foreach my $gt ($rs->all()) {
  91 #    push @gt, $gt->value();
  92 #}
  93
  94 print STDERR Dumper(\@gt);
  95
  96 my $gt = CXGN::Genotype->new();
  97
  98 my $gt_json = {
  99     'marker1' => {'DS'=>"0"},
 100     'marker2' => {'DS'=>"0"},
 101     'marker3' => {'DS'=>"1"},
 102     'marker4' => {'DS'=>"2"},
 103     'marker5' => {'DS'=>"0.9"}
 104 };
 105
 106 $gt->from_json(encode_json $gt_json);
 107
 108 my $markers = $gt->markers();
 109
 110 is(scalar(@$markers), 5, "marker number test");
 111
 112 my $gt2 = CXGN::Genotype->new();
 113
 114 my $gt_json2 = {
 115     'marker1' => {'DS'=>"0"},
 116     'marker3' => {'DS'=>"1"},
 117     'marker4' => {'DS'=>"1"},
 118     'marker5' => {'DS'=>"0.9"},
 119     'marker6' => {'DS'=>"0"}
 120 };
 121
 122 $gt2->from_json(encode_json $gt_json2);
 123
 124 is($gt->calculate_distance($gt2), 0.75, "distance calculation test");
 125 is($gt->good_score('0.0'), 1, "good score test 1");
 126 is($gt->good_score('1.1'), 1, "good score test 2");
 127 is($gt->good_score('2'), 1, "good score test 3");
 128 is($gt->good_score(-2), 0, "good score test 4");
 129 is($gt->good_score(3), 0, "good score test 5");
 130 is($gt->good_score('NA'), 0, "good score test 3");
 131 is($gt->good_score(undef), 0, "good score test 4");
 132 is($gt->good_score('?'), 0, "good score test 5");
 133 is($gt->scores_are_equal('0', '0'), 1, "scores are equal test 1");
 134 is($gt->scores_are_equal('1.1', '1.2'), 1, "scores are equal test 2");
 135 is($gt->scores_are_equal(undef, '0'), 0, "scores are equal test 3");
 136 is($gt->scores_are_equal(undef, undef), 0, "scores are equal test 4");
 137 is($gt->scores_are_equal('NA', 'NA'), 0, "scores are equal test 5");
 138 is($gt->scores_are_equal('?', '?'), 0, "scores are equal test 6");
 139
 140 $f->clean_up_db();
 141 done_testing();