File: Sanity.pm

package info (click to toggle)
libdemeter-perl 0.9.27%2Bds6-9
  • links: PTS, VCS
  • area: contrib
  • in suites: forky, sid, trixie
  • size: 74,028 kB
  • sloc: perl: 73,233; python: 2,196; makefile: 1,999; ansic: 1,368; lisp: 454; sh: 74
file content (213 lines) | stat: -rw-r--r-- 5,922 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
package Demeter::Path::Sanity;

=for Copyright
 .
 Copyright (c) 2006-2019 Bruce Ravel (http://bruceravel.github.io/home).
 All rights reserved.
 .
 This file is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself. See The Perl
 Artistic License.
 .
 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut

use autodie qw(open close);

use Moose::Role;

use Carp;
use List::MoreUtils qw(any);
use Demeter::Constants qw($EPSILON5 $NUMBER);


my %pp_trans = ('3rd'=>"third", '4th'=>"fourth", dphase=>"dphase",
		dr=>"delr", e0=>"e0", ei=>"ei", s02=>"s02", ss2=>"sigma2");
sub is_resonable {
  my ($self, $param) = @_;
  $param = lc($param);
  ($param = "s02") if ($param eq "so2");
  my ($value, $explanation) = (1, q{});
 SWITCH: {
    ($param eq "e0") and do {
      ($value, $explanation) = $self->test_e0;
      last SWITCH;
    };
    ($param eq "s02") and do {
      ($value, $explanation) = $self->test_s02;
      last SWITCH;
    };
    ($param =~ m{^s(?:ig|s)}) and do {
      ($value, $explanation) = $self->test_sigma2;
      last SWITCH;
    };
    ($param eq "delr") and do {
      ($value, $explanation) = $self->test_delr;
      last SWITCH;
    };
    (($param eq "3rd") or ($param eq "third")) and do {
      ($value, $explanation) = $self->test_third;
      last SWITCH;
    };
    (($param eq "4th") or ($param eq "fourth")) and do {
      ($value, $explanation) = $self->test_fourth;
      last SWITCH;
    };
    ($param eq "dphase") and do {
      ($value, $explanation) = (1, q{});
      last SWITCH;
    };
    ($param =~ m{array}) and do {
      ($value, $explanation) = (1, q{});
      last SWITCH;
    };
  };

  return ($value, $explanation);
};

sub test_e0 {
  my ($self) = @_;
  my $config = $self->co;
  my $e0_max = $config->default("warnings", "e0_max");
  my $this = abs($self->e0_value);
  return (1, q{}) if ($e0_max == 0);
  return (1, q{}) if ($this < $e0_max);
  my $id = $self->identity;
  return (0, sprintf("The absolute value of e0 for \"$id\" is greater than %s.", $e0_max));
};

sub test_s02 {
  my ($self) = @_;
  my $config = $self->co;
  my $this = $self->s02_value;
  my $id = $self->identity;
  return (0, "S02 for \"$id\" is negative.")
    if ($config->default("warnings", "s02_neg") and ($this < -1*$EPSILON5));
  return (1, q{}) if ($config->default("warnings", "s02_max") == 0);
  ## return(0, "Too big") if too big
  ## return(0, "Too small") if too small
  return (1, q{});
};

sub test_sigma2 {
  my ($self) = @_;
  my $config = $self->co;
  my $this = $self->sigma2_value;
  my $id = $self->identity;
  return (0, "sigma2 for \"$id\" is negative.")
    if ($config->default("warnings", "ss2_neg") and ($this < -1*$EPSILON5));
  return (1, q{}) if ($config->default("warnings", "ss2_max") == 0);
  return (0, "sigma2 for \"$id\" is suspiciously large.")
    if ($this > $config->default("warnings", "ss2_max"));
  return (1, q{});
};

sub test_delr {
  my ($self) = @_;
  my $config = $self->co;
  my $this = abs($self->delr_value);
  my $id = $self->identity;
  return (0, "delr for \"$id\" is suspiciously large.") 
    if ($this > $config->default("warnings", "dr_max"));
  return (1, q{});
};

sub test_third {
  my ($self) = @_;
  my $this = $self->third_value;
  my $id = $self->identity;
  return (1, q{});
};

sub test_fourth {
  my ($self) = @_;
  my $this = $self->fourth_value;
  my $id = $self->identity;
  return (1, q{});
};


1;


=head1 NAME

Demeter::Path::Sanity - Sanity checks for path parameter values

=head1 VERSION

This documentation refers to Demeter version 0.9.26.

=head1 SYNOPSIS

  my ($isok, $reason) = $pathobject -> is_reasonable("e0");
  print $reason if (not $is_ok);

     ==> The absolute value of e0 for "path label" is greater than 10 ev

=head1 DESCRIPTION

This module provides a series of rules for determining the
appropriateness of fitted path parameter values.  These rules are all
configurable, but tend to be checks on the magnitude and/or parity of
the evaluated parameter.  See the warnings configuration group.

The user should never need to call the methods explicitly since they
are called automatically whenever a fit or a sum is performed.
However they are documented here so that the scope of such checks made
is clearly understood.

These rules are among the criteria used to evaluate the fit happiness.
See <Demeter::Fit::Happiness>.

=head1 METHODS

Test are made on the reasonableness of the C<e0>, C<s02>, C<delr>,
C<sigma2>, C<ei>, C<third>, and C<fourth> path parameters, as defined
by the warnings configuration group.

The only method intended for external use is C<is_reasonable>, as
shown in the L</SYNOPIS>.  It returns a two-element list, the first
element being a flag indicating whether the path parameter passed its
tests and the second being an explanation of the problem, if one is
found.

=head1 CONFIGURATION AND ENVIRONMENT

See L<Demeter::Config> for a description of the configuration system.
See the warnings configuration group.

=head1 DEPENDENCIES

Demeter's dependencies are in the F<Build.PL> file.

=head1 BUGS AND LIMITATIONS

Please report problems to the Ifeffit Mailing List
(L<http://cars9.uchicago.edu/mailman/listinfo/ifeffit/>)

Patches are welcome.

=head1 AUTHOR

Bruce Ravel (L<http://bruceravel.github.io/home>)

L<http://bruceravel.github.io/demeter/>


=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006-2019 Bruce Ravel (L<http://bruceravel.github.io/home>). All rights reserved.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlgpl>.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

=cut