Mercurial > repos > dereeper > roary_plots

comparison Roary/t/Bio/Roary/OrderGenes.t @ 0:c47a5f61bc9f draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author dereeper
date Fri, 14 May 2021 20:27:06 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:c47a5f61bc9f
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Data::Dumper;
5 use File::Slurper 'read_text';
6 use Test::Files;
7
8 BEGIN { unshift( @INC, './lib' ) }
9 $ENV{PATH} .= ":./bin";
10
11 BEGIN {
12 use Test::Most;
13 use_ok('Bio::Roary::OrderGenes');
14 use Bio::Roary::AnalyseGroups;
15 }
16
17 my $no_accessory_100 = order_genes_obj( 't/data/accessory_graphs/no_accessory', 1 );
18 my $no_accessory_50 = order_genes_obj( 't/data/accessory_graphs/no_accessory', 0.5 );
19
20 my $one_bubble_100 = order_genes_obj( 't/data/accessory_graphs/one_bubble', 1 );
21 my $one_bubble_50 = order_genes_obj( 't/data/accessory_graphs/one_bubble', 0.5 );
22
23 my $one_branch_100 = order_genes_obj( 't/data/accessory_graphs/one_branch', 1 );
24 my $one_branch_50 = order_genes_obj( 't/data/accessory_graphs/one_branch', 0.5 );
25
26 my $two_graphs_100 = order_genes_obj( 't/data/accessory_graphs/two_graphs', 1 );
27 my $two_graphs_50 = order_genes_obj( 't/data/accessory_graphs/two_graphs', 0.5 );
28
29 my $single_gene_100 = order_genes_obj( 't/data/accessory_graphs/single_gene_contig', 1 );
30 my $single_gene_50 = order_genes_obj( 't/data/accessory_graphs/single_gene_contig', 0.5 );
31
32 my $core_deletion_100 = order_genes_obj( 't/data/accessory_graphs/core_deletion', 1 );
33 my $core_deletion_50 = order_genes_obj( 't/data/accessory_graphs/core_deletion', 0.5 );
34
35 my $core_island_100 = order_genes_obj( 't/data/accessory_graphs/core_island', 1 );
36 my $core_island_50 = order_genes_obj( 't/data/accessory_graphs/core_island', 0.5 );
37
38 cleanup();
39 my $analyse_groups = Bio::Roary::AnalyseGroups->new(
40 fasta_files => [ 't/data/accessory_graphs/file_1.fa', 't/data/accessory_graphs/file_2.fa', 't/data/accessory_graphs/file_3.fa' ],
41 groups_filename => 't/data/accessory_graphs/core_island'
42 );
43
44 ok(
45 my $obj = Bio::Roary::OrderGenes->new(
46 analyse_groups_obj => $analyse_groups,
47 gff_files => [ 't/data/accessory_graphs/file_1.gff', 't/data/accessory_graphs/file_2.gff', 't/data/accessory_graphs/file_3.gff' ],
48 core_definition => 1,
49 sample_weights => { 'file_1' => 0.5, 'file_2' => 1, 'file_3' => 0.1 }
50 ),
51 "Initialise order genes object for sample weights"
52 );
53 ok( $obj->groups_to_contigs, 'build the graph for sample weights' );
54 ok( -e 'core_accessory_graph.dot', 'core accessory graph created for sample weights' );
55 ok( -e 'accessory_graph.dot', 'accessory graph created for sample weights' );
56
57 my $actual_graph = read_text('accessory_graph.dot');
58 $actual_graph =~ s/group_[\w]/group_X/gi;
59 is_deeply( $actual_graph, read_text('t/data/expected_sample_weights_accessory_graph.dot'), 'graph weights changed' );
60
61 # Check how the final graphs get reordered.
62
63 $obj = Bio::Roary::OrderGenes->new(
64 analyse_groups_obj => $analyse_groups,
65 gff_files => [ 't/data/accessory_graphs/file_1.gff', 't/data/accessory_graphs/file_2.gff', 't/data/accessory_graphs/file_3.gff' ],
66 core_definition => 1,
67 sample_weights => { 'file_1' => 0.5, 'file_2' => 1, 'file_3' => 0.1 },
68 samples_to_clusters => { 's1' => 'c1', 's2' => 'c1', 's3' => 'c2', 's4' => 'c2' },
69 );
70
71 my @paths_and_weights = (
72 {
73 path => [ 'g1', 'g2' ],
74 average_weight => 3,
75 sample_names => [ 's1', 's2' ]
76 },
77 {
78 path => [ 'g5', 'g6' ],
79 average_weight => 2,
80 sample_names => [ 's3', 's4' ]
81 },
82 {
83 path => [ 'g3', 'g4' ],
84 average_weight => 1,
85 sample_names => [ 's1', 's2' ]
86 }
87 );
88 my @expected_path_order = ( [ 'g1', 'g2' ], [ 'g3', 'g4' ], [ 'g5', 'g6' ] );
89 is_deeply( $obj->_order_by_samples_and_weights( \@paths_and_weights ), \@expected_path_order, 'graphs reordered as expected' );
90
91 cleanup();
92 done_testing();
93
94 sub order_genes_obj {
95 my ( $groups_filename, $core_definition ) = @_;
96
97 cleanup();
98 my $analyse_groups = Bio::Roary::AnalyseGroups->new(
99 fasta_files => [ 't/data/accessory_graphs/file_1.fa', 't/data/accessory_graphs/file_2.fa', 't/data/accessory_graphs/file_3.fa' ],
100 groups_filename => $groups_filename
101 );
102
103 ok(
104 my $obj = Bio::Roary::OrderGenes->new(
105 analyse_groups_obj => $analyse_groups,
106 gff_files =>
107 [ 't/data/accessory_graphs/file_1.gff', 't/data/accessory_graphs/file_2.gff', 't/data/accessory_graphs/file_3.gff' ],
108 core_definition => $core_definition
109 ),
110 "Initialise order genes object for $groups_filename"
111 );
112
113 ok( $obj->groups_to_contigs, 'build the graph' );
114 check_all_groups_in_output_graph( $groups_filename, $obj->groups_to_contigs, $core_definition );
115 ok( -e 'core_accessory_graph.dot', 'core accessory graph created' );
116 ok( -e 'accessory_graph.dot', 'accessory graph created' );
117
118 return $obj;
119 }
120
121 sub check_all_groups_in_output_graph {
122 my ( $groups_filename, $groups_to_contigs, $core_definition ) = @_;
123
124 open( my $groups_in, $groups_filename );
125 while (<$groups_in>) {
126 chomp;
127 my $line = $_;
128 next if ( $line eq '' );
129 my ( $group, $attributes ) = split( ':', $line );
130 ok( ( $groups_to_contigs->{$group} ), "group $group found in file $groups_filename" );
131
132 # Check to see if the accessory groups are tagged properly
133 $attributes =~ s/ //gi;
134 my @sequence_ids = split( /\t/, $attributes );
135 if ( @sequence_ids >= 3 * $core_definition ) {
136 ok( !defined( $groups_to_contigs->{$group}->{accessory_label} ), "group $group is core so shouldnt have any accessory labels" );
137 }
138 else {
139 ok( defined( $groups_to_contigs->{$group}->{accessory_label} ), "group $group is accessory so should have accessory label" );
140 }
141 }
142 }
143
144 sub cleanup {
145 unlink('core_accessory_graph.dot');
146 unlink('accessory_graph.dot');
147 }
148