~ubuntu-branches/ubuntu/utopic/circos/utopic-proposed

« back to all changes in this revision

Viewing changes to lib/Circos/Rule.pm

  • Committer: Package Import Robot
  • Author(s): Olivier Sallou, Olivier Sallou, Charles Plessy, Andreas Tille
  • Date: 2012-06-14 12:56:33 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20120614125633-0wh7ovv69s5k1uiq
Tags: 0.61-1
[ Olivier Sallou ]
* New upstream release

[ Charles Plessy ]
* renamed debian/upstream-metadata.yaml to debian/upstream

[ Andreas Tille ]
* debian/upstream: enhanced citation information 

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
package Circos::Rule;
 
2
 
 
3
=pod
 
4
 
 
5
=head1 NAME
 
6
 
 
7
Circos::Rule - routines for handling rules in Circos
 
8
 
 
9
=head1 SYNOPSIS
 
10
 
 
11
This module is not meant to be used directly.
 
12
 
 
13
=head1 DESCRIPTION
 
14
 
 
15
Circos is an application for the generation of publication-quality,
 
16
circularly composited renditions of genomic data and related
 
17
annotations.
 
18
 
 
19
Circos is particularly suited for visualizing alignments, conservation
 
20
and intra and inter-chromosomal relationships. However, Circos can be
 
21
used to plot any kind of 2D data in a circular layout - its use is not
 
22
limited to genomics. Circos' use of lines to relate position pairs
 
23
(ribbons add a thickness parameter to each end) is effective to
 
24
display relationships between objects or positions on one or more
 
25
scales.
 
26
 
 
27
All documentation is in the form of tutorials at L<http://www.circos.ca>.
 
28
 
 
29
=cut
 
30
 
 
31
# -------------------------------------------------------------------
 
32
 
 
33
use strict;
 
34
use warnings;
 
35
 
 
36
use base 'Exporter';
 
37
our @EXPORT = qw();
 
38
 
 
39
use Carp qw( carp confess croak );
 
40
use Data::Dumper;
 
41
use FindBin;
 
42
use GD::Image;
 
43
use Params::Validate qw(:all);
 
44
 
 
45
use lib "$FindBin::RealBin";
 
46
use lib "$FindBin::RealBin/../lib";
 
47
use lib "$FindBin::RealBin/lib";
 
48
 
 
49
use Circos::Configuration; # qw(%CONF $DIMS);
 
50
use Circos::Constants;
 
51
use Circos::Debug;
 
52
use Circos::Error;
 
53
use Circos::Expression;
 
54
use Circos::Utils;
 
55
 
 
56
use Memoize;
 
57
 
 
58
for my $f ( qw() ) {
 
59
memoize($f);
 
60
}
 
61
 
 
62
sub make_rule_list {
 
63
        my $conf_leaf = shift;
 
64
        my @rules     = make_list( $conf_leaf );
 
65
        # first, grep out rules that have an importance value
 
66
        my @rules_ordered = sort { $b->{importance} <=> $a->{importance} } grep(defined $_->{importance}, @rules);
 
67
        # then add all remaining rules without importance
 
68
        push @rules_ordered, grep(! defined $_->{importance}, @rules);
 
69
        @rules = @rules_ordered;
 
70
        # sanity checks
 
71
        # - condition must exist
 
72
        # - assign tag automatically, if does not exist
 
73
        # - create a list of parameters that are being readjusted
 
74
        for my $i (0..@rules-1) {
 
75
                my $rule = $rules[$i];
 
76
                if(! defined $rule->{condition} && ! defined $rule->{flow}) {
 
77
            $Data::Dumper::Sortkeys = 1;
 
78
            $Data::Dumper::Terse    = 1;
 
79
            fatal_error("rule","no_condition_no_flow",Dumper($rule));
 
80
                }
 
81
                if(! defined $rule->{tag}) {
 
82
            my $tag = $i;
 
83
            printdebug_group("rule","assigning auto rule tag [$tag]");
 
84
            $rule->{tag} = $tag;
 
85
                }
 
86
                $rule->{__param} ||= {};
 
87
                for my $key (keys %$rule) {
 
88
                        next if grep($key eq $_, qw(condition importance tag flow __param));
 
89
                        $rule->{__param}{$key}++;
 
90
                }
 
91
        }
 
92
        return @rules;
 
93
}
 
94
 
 
95
sub apply_rules_to_track {
 
96
    my ($track, $rules, $param_path) = @_;
 
97
    
 
98
    my $goto_rule_tag;
 
99
    my $have_restarted;
 
100
  POINT:
 
101
    for my $point ( @{ $track->{__data} } ) {
 
102
      RULE:
 
103
        for my $rule ( @$rules ) {
 
104
            if(defined $goto_rule_tag) {
 
105
                if($rule->{tag} ne $goto_rule_tag) {
 
106
                    printdebug_group("rule","going to rule [$goto_rule_tag] and skipping rule [$rule->{tag}]");
 
107
                    next RULE;
 
108
                } else {
 
109
                    printdebug_group("rule","found rule [$goto_rule_tag]");
 
110
                    $goto_rule_tag = undef;
 
111
                }
 
112
            }
 
113
            
 
114
            my $condition = $rule->{condition};
 
115
            my @flows     = make_list(seek_parameter( "flow", $rule, $track->{rules} ));
 
116
            my $pass      = test_rule( $point, $condition, [ $point, @$param_path ] ) if defined $condition;
 
117
            
 
118
            apply_rule_to_point($point,$rule,$param_path) if $pass;
 
119
            # if flow is not defined
 
120
            
 
121
            if(! @flows) {
 
122
                                if($pass) {
 
123
                                        printdebug_group("rule","quitting rule chain");
 
124
                                        last RULE;
 
125
                                } else {
 
126
                                        printdebug_group("rule","trying next rule");
 
127
                                        next RULE;
 
128
                                }
 
129
            } else {
 
130
                                for my $flow (@flows) {
 
131
                                        my @flow_tok = split(" ",$flow);
 
132
                                        # if the flow string ends with "if true" or "if false" register
 
133
                                        # whether the flow command should be executed based on whether
 
134
                                        # the rule has passed
 
135
                                        printdebug_group("rule","parsing flow",$flow);
 
136
                                        my $toggle_flow;
 
137
                                        if($flow =~ /\s+if\s+/) {
 
138
                                                if($flow =~ /\s+true\s*$/) {
 
139
                                                        $toggle_flow = $pass ? 1 : 0;
 
140
                                                } elsif ($flow =~ /\s+false\s*$/) {
 
141
                                                        $toggle_flow = !$pass ? 1 : 0;
 
142
                                                } else {
 
143
                                                        fatal_error("rules","flow_syntax_error",$flow);
 
144
                                                }
 
145
                                        } else {
 
146
                                                # by default the flow will trigger
 
147
                                                $toggle_flow = 1;
 
148
                                        }
 
149
                                        printdebug_group("rule","rule pass",$pass,"flow",$toggle_flow);
 
150
                                        
 
151
                                        if($flow =~ /^stop/) {
 
152
                                                if($toggle_flow) {
 
153
                                                        last RULE;
 
154
                                                }
 
155
                                        } elsif ($flow =~ /^goto/) {
 
156
                                                my (undef,$tag,$if,$ifcond) = @flow_tok;
 
157
                                                if($toggle_flow) {
 
158
                                                        $goto_rule_tag = $tag;
 
159
                                                        printdebug_group("rule","goto to rule [$tag]");
 
160
                                                        goto RULE;
 
161
                                                }
 
162
                                        } elsif ($flow =~ /^restart/) {
 
163
                                                if($toggle_flow) {
 
164
                                                        if(!$rule->{restart}) {
 
165
                                                                $rule->{restart} = 1;
 
166
                                                                $have_restarted  = 1;
 
167
                                                                printdebug_group("rule","restarting rule chain");
 
168
                                                                goto RULE;
 
169
                                                        } else {
 
170
                                                                printdebug_group("rule","cannot restart from rule more than once - quitting rule chain");
 
171
                                                                last RULE;
 
172
                                                        }
 
173
                                                }
 
174
                                        } elsif ($flow =~ /^continue/) {
 
175
                                                if($toggle_flow) {
 
176
                                                        printdebug_group("rule","continuing to next rule");
 
177
                                                        next RULE;
 
178
                                                }
 
179
                                        } else {
 
180
                                                fatal_error("rules","flow_syntax_error",$flow,$rule->{tag});
 
181
                                        }
 
182
                                }
 
183
                        }
 
184
                }
 
185
                
 
186
    if(defined $goto_rule_tag) {
 
187
                        fatal_error("rule","bad_tag",$goto_rule_tag);
 
188
    }
 
189
    # clear restart flags
 
190
    if($have_restarted) {
 
191
                        map { delete $_->{restart} } @$rules;
 
192
    }
 
193
        }
 
194
}
 
195
 
 
196
sub apply_rule_to_point {
 
197
        my ($point,$rule,$param_path) = @_;
 
198
        for my $param ( keys %{ $rule->{__param} } ) {
 
199
                my $value = $rule->{$param};
 
200
                printdebug_group("rule","applying rule var",$param,"value",$value);
 
201
                if ( $value =~ /^eval\(\s*(.*)\s*\)\s*$/ ) {
 
202
                        my $expr = $1;
 
203
                        $value = Circos::Expression::eval_expression( $point, $expr, [ $point, @$param_path ] );
 
204
                }
 
205
                
 
206
                if ( $param eq "value" || $param eq "start" || $param eq "end" ) {
 
207
                if($value eq "undef") {
 
208
                    delete $point->{data}[0]{ $param };
 
209
                } else {
 
210
                    $point->{data}[0]{ $param } = $value;
 
211
                }
 
212
            } else {
 
213
                if ( not_defined_or_one( $rule->{overwrite} ) ) {
 
214
                    # overwrite is default
 
215
                    if($value eq "undef") {
 
216
                        delete $point->{param}{ $param };
 
217
                    } else {
 
218
                        $point->{param}{ $param } = $value;
 
219
                    }
 
220
                } elsif ( ! exists $point->{param}{$param} ) {
 
221
                    # overwrite only if parameter doesn't exist
 
222
                        if($value ne "undef") {
 
223
                            $point->{param}{$param} = $value;
 
224
                    }
 
225
                        }
 
226
                }
 
227
        }
 
228
}
 
229
 
 
230
# -------------------------------------------------------------------
 
231
sub test_rule {
 
232
  my ( $point, $condition, $param_path ) = @_;
 
233
        for my $c (make_list($condition)) {
 
234
                my $cfmt = Circos::Expression::format_condition($c);
 
235
                my $pass   = Circos::Expression::eval_expression($point,$cfmt,$param_path);
 
236
                printdebug_group("rule","condition [$condition] pass",$pass ? "PASS" : "FAIL");
 
237
                return 0 if ! $pass;
 
238
        }
 
239
  return 1;
 
240
}
 
241
 
 
242
1;