~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to Demos/BAD_demo.pm.PL

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#
 
2
# Create BAD_demo.pm
 
3
# - needed since we allow bad pixel handling to be switched off
 
4
#
 
5
 
 
6
use strict;
 
7
 
 
8
use Config;
 
9
use File::Basename qw(&basename &dirname);
 
10
 
 
11
# check for bad value support
 
12
use PDL::Config;
 
13
my $bvalflag = $PDL::Config{WITH_BADVAL} || 0;
 
14
 
 
15
# This forces PL files to create target in same directory as PL file.
 
16
# This is so that make depend always knows where to find PL derivatives.
 
17
chdir(dirname($0));
 
18
my $file;
 
19
($file = basename($0)) =~ s/\.PL$//;
 
20
$file =~ s/\.pl$//
 
21
        if ($Config{'osname'} eq 'VMS' or
 
22
            $Config{'osname'} eq 'OS2');  # "case-forgiving"
 
23
open OUT,">$file" or die "Can't create $file: $!";
 
24
 
 
25
if ( $bvalflag ) {
 
26
    print "Extracting $file (WITH bad value support)\n";
 
27
} else {
 
28
    print "Extracting $file (NO bad value support)\n";
 
29
}
 
30
chmod 0644, $file;
 
31
 
 
32
print OUT <<'!NO!SUBS!';
 
33
#
 
34
# Created by BAD_demo.pm.PL
 
35
#  ** DO NOT EDIT THIS FILE **
 
36
#
 
37
package PDL::Demos::BAD_demo;
 
38
use PDL;
 
39
 
 
40
PDL::Demos::Routines->import();
 
41
sub comment($);
 
42
sub act($);
 
43
sub output;
 
44
 
 
45
sub run {
 
46
 
 
47
!NO!SUBS!
 
48
 
 
49
    if ( ! $bvalflag ) {
 
50
        print OUT <<'!NO!SUBS!';
 
51
 
 
52
comment q|
 
53
 
 
54
    Your version of PDL has been compiled without support for bad
 
55
    values, hence this demo doesn't do anything.
 
56
 
 
57
|;
 
58
 
 
59
!NO!SUBS!
 
60
 
 
61
#'
 
62
 
 
63
} else {
 
64
    print OUT <<'!NO!SUBS!';
 
65
 
 
66
comment q|
 
67
    Welcome to this tour of the bad value support in PDL
 
68
 
 
69
    Each piddle contains a flag - accessible via the badflag() method - 
 
70
    which indicates whether:
 
71
 
 
72
       the piddle contains no bad values (flag equals 0)
 
73
       the piddle *MAY* contain bad values (flag equals 1)
 
74
 
 
75
    If the flag is set, then the routines (well, those that have been
 
76
    converted) will process these bad values correctly, otherwise they 
 
77
    are ignored. 
 
78
 
 
79
    The code has been written so as to provide as little overhead as
 
80
    possible; therefore there should be almost no difference in the
 
81
    time it takes to process piddles which do not have their bad flag 
 
82
    set.
 
83
 
 
84
|;
 
85
 
 
86
act q|
 
87
 
 
88
    # There are 2 ways to see whether bad-value support has been
 
89
    # compiled into your perldl:
 
90
    print("You can use bad values.\n") if $PDL::Bad::Status;
 
91
 
 
92
    # or
 
93
    use PDL::Config;
 
94
    print("You can stil use bad values.\n") if $PDL::Config{WITH_BADVAL};
 
95
 
 
96
    # note that PDL::Bad is included by default when you use 
 
97
    # 'use PDL', 'use PDL::Lite', or 'use PDL::LiteF'
 
98
 
 
99
|;
 
100
 
 
101
act q|
 
102
 
 
103
    # create a piddle
 
104
    $a = byte(1,2,3);
 
105
    print( "Bad flag (a) == ", $a->badflag(), "\n" );
 
106
 
 
107
    # set bad flag, even though all the data is good
 
108
    $a->badflag(1);
 
109
    print( "Bad flag (a) == ", $a->badflag(), "\n" );
 
110
 
 
111
    # note the bad flag is infectious
 
112
    $b = 2 * $a;
 
113
    print( "Bad flag (b) == ", $b->badflag(), "\n\n" );
 
114
 
 
115
|;
 
116
 
 
117
act q|
 
118
 
 
119
    # the badflag is also included in the state info of
 
120
    # piddle
 
121
    #
 
122
    $c = pdl(2,3); # just a piddle without the badflag set
 
123
 
 
124
    print "   Type   Dimension        State          Mem\n";
 
125
    print "-------------------------------------------------\n";
 
126
    print "a ", $a->info("%-6T %-15D   %-5S  %12M"), "\n";
 
127
    print "b ", $b->info("%-6T %-15D   %-5S  %12M"), "\n";
 
128
    print "c ", $c->info("%-6T %-15D   %-5S  %12M"), "\n\n";
 
129
|;
 
130
 
 
131
act q|
 
132
 
 
133
    print "No bad values:   $a\n";
 
134
    # set the middle value bad
 
135
    $a->setbadat(1);
 
136
 
 
137
    # now print out
 
138
    print "Some bad values: $a\n";
 
139
    print "b contains:      $b\n";
 
140
    $c = $a + $b;
 
141
    print "so a + b =       $c\n\n";
 
142
 
 
143
|;
 
144
 
 
145
act q|
 
146
 
 
147
    # The module PDL::Bad contains a number of routines designed
 
148
    # to make using bad values easy.
 
149
    print "a contains ", $a->nbad, " bad elements.\n";
 
150
    print "The bad value for type #",$a->get_datatype," is ",$a->badvalue,"\n";
 
151
    print "It is easy to find whether a value is good: ", isgood($a), "\n\n";
 
152
 
 
153
    print "or to remove the bad values\n";
 
154
    $a->inplace->setbadtoval(23);
 
155
    print "a = $a and \$a->badflag == ", $a->badflag, "\n\n";
 
156
 
 
157
|;
 
158
 
 
159
act q|
 
160
 
 
161
    print "We can even label certain values as bad!\n";
 
162
    $a = sequence(3,3);
 
163
    $a = $a->setbadif( $a % 2 ); # unfortunately can not be done inplace
 
164
    print $a;
 
165
 
 
166
|;
 
167
 
 
168
act q|
 
169
 
 
170
    # the issue of how to cope with dataflow is not fully resolved. At
 
171
    # present, if you change the badflag of a piddle, all its children
 
172
    # are also changed:
 
173
    $a = sequence( byte, 2, 3 );
 
174
    $a = $a->setbadif( $a == 3 );
 
175
    $b = $a->slice("(1),:");
 
176
    print "b = $b\tbadflag = ", $b->badflag, "\n";
 
177
 
 
178
    $a->inplace->setbadtoval(3);
 
179
    print "b = $b\tbadflag = ", $b->badflag, "\n\n";
 
180
 
 
181
|;
 
182
 
 
183
act q|
 
184
 
 
185
    # Note that "boolean" operators return a bad value if either of the
 
186
    # operands are bad: one way around this is to replace all bad values
 
187
    # by 0 or 1. 
 
188
 
 
189
    $a = sequence(3,3); $a = $a->setbadif( $a % 2 );
 
190
    print $a > 5;
 
191
    print setbadtoval($a > 5,0);  # set all bad values to false
 
192
 
 
193
|;
 
194
 
 
195
act q|
 
196
    # One area that is likely to cause confusion is the return value from
 
197
    # comparison operators (e.g. all and any) when ALL elements are bad.
 
198
 
 
199
    # Currently, the bad value is returned; however most code will not
 
200
    # be aware of this and just see it as a true or false value (depending
 
201
    # on the numerical value used to store bad values).
 
202
 
 
203
    # There is also the fact that the bad value need not relate to the
 
204
    # type of the input piddle (due to internal conversion to an 'int +').
 
205
    
 
206
    $a = ones(3); $a = $a->setbadif( $a == 1 );
 
207
    print "Any returns: ", any( $a > 2 ), "\n";
 
208
    print "which is the bad value of 'long' (", long->badvalue, ").\n";
 
209
 
 
210
    print "Whereas the bad value for \$a is: ", $a->badvalue, "\n";
 
211
 
 
212
|;
 
213
 
 
214
comment q|
 
215
    Many of the 'core' routines have been converted to handle bad values.
 
216
    However, some (including most of the additional modules) have not,
 
217
    either because it does not make sense or its too much work to do! 
 
218
 
 
219
    To find out the status of a particular routine, use the 'badinfo'
 
220
    command in perldl (this information is also included when you do
 
221
    'help'), or the '-b' switch of pdldoc.
 
222
 
 
223
|;
 
224
 
 
225
!NO!SUBS!
 
226
 
 
227
} # if: $bvalflag
 
228
 
 
229
print OUT <<'!NO!SUBS!';
 
230
 
 
231
}
 
232
 
 
233
1;
 
234
 
 
235
!NO!SUBS!
 
236
 
 
237
# end