[system] / trunk / pg / lib / List.pm Repository:
ViewVC logotype

Annotation of /trunk/pg/lib/List.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4827 - (view) (download) (as text)

1 : apizer 1079
2 : sh002i 1050 #New highly object-oriented list construct
3 :     #This List.pm is the super class for all types of lists
4 :     #As of 6/5/2000 the three list sub-classes are Match, Select, Multiple
5 :     #RDV
6 :    
7 :     =head1 NAME
8 :    
9 :     List.pm -- super-class for all list structures
10 :    
11 :     =head1 SYNOPSIS
12 :    
13 :     =pod
14 :    
15 :     List.pm is not intended to be used as a stand alone object.
16 :    
17 : apizer 1079 It is a super-class designed to be inherited by sub-classes that,
18 :     through small changes, can be used for a variety of different
19 : sh002i 1050 questions that involve some sort of list of questions and/or answers.
20 :    
21 :     List.pm has been used to construct Match.pm, Select.pm, and Multiple.pm.
22 :    
23 : apizer 1079 These three classes are objects that can be used to create the
24 : sh002i 1050 following question types:
25 :    
26 :     B<Matching list:>
27 : apizer 1079 Given a list of questions and answers, match the correct answers to the
28 :     questions. Some answers may be used more than once and some may not be used at
29 :     all. The order of the answers is usually random but some answers can be
30 :     appended to the end in a set order (i.e. 'None of the above'). Answers are
31 :     given corresponding letters as shortcuts to typing in the full answer. (i.e.
32 : sh002i 1050 the answer to #1 is A).
33 :    
34 : apizer 1079 B<Select list:>
35 :     Given a list of questions and (usually) implied answers, give the correct
36 :     answer to each question. This is intended mainly for true/false questions or
37 :     other types of questions where the answers are short and can therefore be typed
38 :     in by the user easily. If a select list is desired but the answers are too long
39 :     to really type in, a popup-list of the answers can be used.
40 : sh002i 1050
41 : apizer 1079 B<Multiple choice:>
42 :     Given a single question and a list of answers, select the single correct answer.
43 :     This structure creates a standard multiple choice question as would be seen on a
44 :     standardize test. Extra answers are entered along with the question in a simple
45 :     format and (as with Match.pm), if necessary, can be appended in order at the end
46 : sh002i 1050 (i.e. 'None of the above')
47 :    
48 :     =for html
49 :     <P>See <a href="Match">Match.pm</a>, <a href="Select">Select.pm</a>, <a href="Multiple">Multiple.pm</a>, and <a href="PGchoicemacros">PGchoicemacros.pl</a>
50 :    
51 :    
52 :     =head1 DESCRIPTION
53 :    
54 : apizer 1079 =head2 Variables and methods available to sub-classes
55 : sh002i 1050
56 :     =head3 Variables
57 :    
58 :     questions # array of questions as entered using qa()
59 :     answers # array of answers as entered using qa()
60 :     extras # array of extras as entered using extra()
61 : apizer 1079
62 : sh002i 1050 selected_q # randomly selected subset of "questions"
63 :     selected_a # the answers for the selected questions
64 :     selected_e # randomly selected subset of "extras"
65 : apizer 1079
66 :     ans_rule_len # determines the length of the answer blanks
67 : sh002i 1050 # default is 4
68 : apizer 1079
69 : sh002i 1050 slice # index used to select specific questions
70 : apizer 1079 shuffle # permutation array which can be applied to slice
71 : sh002i 1050 # to shuffle the answers
72 : apizer 1079
73 : sh002i 1050 inverted_shuffle # the inverse permutation array
74 : apizer 1079
75 : sh002i 1050 rf_print_q # reference to any subroutine which should
76 :     # take ($self, @questions) as parameters and
77 :     # output the questions in a formatted string.
78 :     # If you want to change the way questions are
79 :     # printed, write your own print method and set
80 :     # this equal to a reference to to that method
81 :     # (i.e. $sl->rf_print_q = ~~&printing_routine_q)
82 : apizer 1079
83 : sh002i 1050 rf_print_a # reference to any subroutine which should
84 :     # take ($self, @answers) as parameters and
85 :     # output the answers in a formatted string.
86 :     # If you want to change the way answers are
87 :     # printed, write your own print method and set
88 :     # this equal to a reference to to that method
89 :     # (i.e. $sl->rf_print_a = ~~&printing_routine_a)
90 : apizer 1079
91 : sh002i 1050 ra_pop_up_list # Field used in sub classes that use pop_up_list_print_q
92 :     # to format the questions. (Placing a pop_up_list next to
93 :     # each question instead of an answer blank.
94 :     # It is initialized to
95 :     # => [no_answer =>' ?', T => 'True', F => 'False']
96 : apizer 1079
97 : sh002i 1050 ans_rule_len # field which can be used in the question printing routines
98 :     # to determine the length of the answer blanks before the questions.
99 :    
100 :     =head3 Methods
101 :    
102 : apizer 1079 qa( array ) # accepts an array of strings which can be used
103 : sh002i 1050 # for questions and answers
104 :    
105 : apizer 1079 extra( array ) # accepts an array of strings which can be used
106 : sh002i 1050 # as extra answers
107 : apizer 1079
108 :     print_q # yields a formatted string of question to be
109 : sh002i 1050 # matched with answer blanks
110 :     print_a # yields a formatted string of answers
111 : apizer 1079
112 :     choose([3, 4], 1) # chooses questions indexed 3 and 4 and one other
113 : sh002i 1050 # randomly
114 : apizer 1079 choose_extra([3, 4], 1) # choooses extra answers indexed 3 and 4 and one
115 : sh002i 1050 # other
116 : apizer 1079 makeLast( array ) # accepts an array of strings (like qa) which will
117 : sh002i 1050 # be forced to the end of the list of answers.
118 : apizer 1079
119 : sh002i 1050 ra_correct_ans # outputs a reference to the array of correct answers
120 :     correct_ans # outputs a concatenated string of correct answers (only for Multiple)
121 :    
122 :     =head2 Usage
123 :    
124 :     None -- see SYNOPSIS above
125 :    
126 :    
127 :     =cut
128 :    
129 :     BEGIN {
130 :     be_strict();
131 :     }
132 :     #use strict;
133 :    
134 :     package List;
135 :    
136 :    
137 :    
138 :     @List::ISA = qw( Exporter );
139 :    
140 :     my %fields = (
141 :     questions => undef,
142 :     answers => undef,
143 :     extras => undef,
144 :     selected_q => undef,
145 :     selected_a => undef,
146 :     selected_e => undef,
147 :     ans_rule_len => undef,
148 :     ra_pop_up_list => undef,
149 :     rf_print_q => undef,
150 :     rf_print_a => undef,
151 :     slice => undef,
152 :     shuffle => undef,
153 :     inverted_shuffle => undef,
154 :     rand_gen => undef,
155 :     );
156 :    
157 :     #used to initialize variables and create an instance of the class
158 :     sub new {
159 :     my $class = shift;
160 :     my $seed = shift;
161 : apizer 1079
162 : sh002i 1050 warn "List requires a random number: new List(random(1,2000,1)" unless defined $seed;
163 : apizer 1079
164 : sh002i 1050 my $self = { _permitted => \%fields,
165 : apizer 1079
166 : sh002i 1050 questions => [],
167 :     answers => [],
168 :     extras => [],
169 :     selected_q => [],
170 :     selected_a => [],
171 :     selected_e => [],
172 :     ans_rule_len => 4,
173 :     ra_pop_up_list => [no_answer =>' ?', T => 'True', F => 'False'],
174 :     rf_print_q => 0,
175 :     rf_print_a => 0,
176 :     slice => [],
177 :     shuffle => [],
178 :     inverted_shuffle => [],
179 :     rand_gen => new PGrandom,
180 :     };
181 : apizer 1079
182 : sh002i 1050 bless $self, $class;
183 : apizer 1079
184 : sh002i 1050 $self->{rand_gen}->srand($seed);
185 : apizer 1079
186 : sh002i 1050 $self->{rf_print_q} = shift;
187 :     $self->{rf_print_a} = shift;
188 : apizer 1079
189 : sh002i 1050 return $self;
190 :     }
191 :    
192 : apizer 1079 # AUTOLOAD allows variables to be set and accessed like methods
193 : sh002i 1050 # returning the value of the variable
194 :     sub AUTOLOAD {
195 :     my $self = shift;
196 :     my $type = ref($self) or die "$self is not an object";
197 : apizer 1079
198 : sh002i 1050 # $AUTOLOAD is sent in by Perl and is the full name of the object (i.e. main::blah::blah_more)
199 :     my $name = $List::AUTOLOAD;
200 :     $name =~ s/.*://; #strips fully-qualified portion
201 : apizer 1079
202 :     unless ( exists $self->{'_permitted'}->{$name} ) {
203 :     die "Can't find '$name' field in object of class '$type'";
204 : sh002i 1050 }
205 : apizer 1079
206 : sh002i 1050 if (@_) {
207 : apizer 1079 return $self->{$name} = shift; #set the variable to the first parameter
208 : sh002i 1050 } else {
209 :     return $self->{$name}; #if no parameters just return the value
210 :     }
211 :     }
212 :    
213 :     sub DESTROY {
214 :     # doing nothing about destruction, hope that isn't dangerous
215 :     }
216 :    
217 :    
218 :     # *** Utility methods ***
219 :    
220 :    
221 :     #choose k random numbers out of n
222 :     sub NchooseK {
223 :     my $self = shift;
224 :     my ($n, $k) = @_;
225 :    
226 :     die "method NchooseK: n = $n cannot be less than k=$k\n
227 :     You probably did a 'choose($k)' with only $n questions!" if $k > $n;
228 : apizer 1079
229 : sh002i 1050 my @array = 0..($n-1);
230 :     my @out = ();
231 : apizer 1079
232 : sh002i 1050 while (@out < $k) {
233 :     push(@out, splice(@array, $self->{rand_gen}->random(0, $#array, 1), 1) );
234 :     }
235 : apizer 1079
236 : sh002i 1050 return @out;
237 :     }
238 :    
239 :     #return an array of random numbers
240 :     sub shuffle {
241 :     my $self = shift;
242 :     my $i = @_;
243 :     my @out = $self->NchooseK($i, $i);
244 : apizer 1079
245 : sh002i 1050 return @out;
246 :     }
247 :    
248 :    
249 :     # *** Utility subroutines ***
250 :    
251 :    
252 :     #swap subscripts with their respective values
253 :     sub invert {
254 :     my @array = @_;
255 :     my @out = ();
256 : apizer 1079
257 : sh002i 1050 for (my $i=0; $i<@array; $i++) {
258 :     $out[$array[$i]] = $i;
259 :     }
260 :    
261 :     return @out;
262 :     }
263 :    
264 :     #slice of the alphabet
265 :     sub ALPHABET {
266 :     return ('A'..'ZZ')[@_];
267 :     }
268 :    
269 : apizer 1079 #given a universe of subscripts and a subset of the universe,
270 : sh002i 1050 #return the complement of that set in the universe
271 :     sub complement {
272 :     my $ra_univ = shift;
273 :     my $ra_set = shift;
274 :     my @univ = @$ra_univ;
275 :     my @set = @$ra_set;
276 : apizer 1079
277 : sh002i 1050 my %set = ();
278 : apizer 1079
279 : sh002i 1050 foreach my $i (@set) {
280 :     $set{$i} = 1;
281 :     }
282 : apizer 1079
283 : sh002i 1050 my @out = ();
284 : apizer 1079
285 : sh002i 1050 foreach my $i (@univ) {
286 :     push(@out, $i) unless exists( $set{$i} );
287 :     }
288 : apizer 1079
289 : sh002i 1050 return @out;
290 :     }
291 :    
292 :    
293 :    
294 :     # *** Input and Output subroutines ***
295 :     #From here down are the ones that should be overloaded by sub-classes
296 :    
297 :     #Input answers
298 :     #defaults to inputting 'question', 'answer', 'question', etc (should be overloaded for other types of questions)
299 :     sub qa {
300 :     my $self = shift;
301 :     my @questANDanswer = @_;
302 : apizer 1079
303 : sh002i 1050 while (@questANDanswer) {
304 :     push (@{ $self->{questions} }, shift(@questANDanswer) );
305 :     push (@{ $self->{answers} }, shift(@questANDanswer) );
306 :     }
307 :     }
308 : apizer 1079
309 : sh002i 1050 #Input extra answers
310 :     sub extra {
311 :     my $self = shift;
312 :     push(@{ $self->{extras} }, @_); #pushing allows multiple calls without overwriting old "extras"
313 :     }
314 :    
315 :    
316 :     #Output questions
317 :     #Doesn't do actual output, refers to method given in call to 'new' (rf_print_q)
318 :     sub print_q {
319 :     my $self = shift;
320 : apizer 1079
321 : sh002i 1050 &{ $self->{rf_print_q} }( $self, @{ $self->{selected_q} } );
322 :     }
323 :    
324 :     #Output answers
325 :     #Doesn't do actual output, refers to method given in call to 'new' (rf_print_a)
326 :     sub print_a {
327 :     my $self = shift;
328 : apizer 1079
329 : sh002i 1050 &{ $self->{rf_print_a} }( $self, @{ $self->{selected_a} } );
330 :     }
331 :    
332 :     #return array of answers to be checked against the students answers
333 :     #defaults to returning the actual selected answers (should be overloaded for other types of answers)
334 :     sub ra_correct_ans {
335 :     my $self = shift;
336 :     return $self->{selected_a};
337 :     }
338 :    
339 :     #Match and Select return references to arrays while Multiple justs returns a string
340 :     #so Match and Select use ra_correct_ans while Multiple uses correct_ans
341 :     sub correct_ans {
342 :     warn "Match and/or Select do not use correct_ans.\nYou should use ra_correct_ans instead.";
343 :     }
344 :    
345 :     # *** Question and Answer Manipulation Subroutines ***
346 :    
347 :    
348 :     #calls methods that deal with list specific methods of picking random questions and answers
349 :     #mainly exists for backward compatibility and to hide some of the activity from the naive user
350 :     sub choose {
351 :     my $self = shift;
352 :     my @input = @_;
353 : apizer 1079
354 : sh002i 1050 $self->getRandoms(scalar(@{$self->{questions}}), @input); #pick random numbers
355 :     $self->selectQA(); #select questions and answers
356 :     $self->dumpExtra(); #dump extra answers into "extras"
357 :     $self->condense(); #eliminate duplicate answers"
358 :     }
359 : apizer 1079
360 :     #randomly inserts the selected extra answers into selected_a and
361 : sh002i 1050 #updates inverted_shuffle accordingly
362 :     sub choose_extra {
363 :     my $self = shift;
364 :     my @input = @_;
365 : apizer 1079
366 : sh002i 1050 $self->getRandoms(scalar(@{ $self->{extras} }), @input);
367 : apizer 1079 $self->{selected_e} = [ @{ $self->{extras} }[ @{ $self->{slice} }[ @{ $self->{shuffle} } ] ] ];
368 : sh002i 1050 my $length = 0;
369 : apizer 1079
370 : sh002i 1050 my $random = 0;
371 :     foreach my $extra_ans ( invert(@{ $self->{shuffle} }) ) {
372 :     #warn "Selected Answers: @{ $self->{selected_a} }<BR>
373 :     # Inverted Shuffle: @{ $self->{inverted_shuffle} }<BR>
374 : apizer 1079 # Random: $random";
375 : sh002i 1050 $random = $self->{rand_gen}->random(0, scalar(@{ $self->{selected_a} }), 1);
376 :     for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
377 :     @{ $self->{inverted_shuffle} }[$pos]++ unless @{ $self->{inverted_shuffle} }[$pos] < $random;
378 :     }
379 :     my @temp = ( @{ $self->{selected_a} }[0..$random-1], @{ $self->{selected_e} }[$extra_ans], @{$self->{selected_a} }[$random..$#{ $self->{selected_a} } ] );
380 :     @{ $self->{selected_a} } = @temp;
381 :     }
382 :     }
383 :    
384 :     #create random @slice and @shuffle to randomize questions and answers
385 :     sub getRandoms {
386 :     my $self = shift;
387 :     my $N = shift;
388 :     my @input = @_;
389 :     my $K = 0;
390 : apizer 1079
391 : sh002i 1050 my @fixed_choices = (); # questions forced by the user
392 :     foreach my $i (@input) { #input is of the form ([3, 5, 6], 3)
393 :     if (ref($i) eq 'ARRAY') {
394 :     push(@fixed_choices, @{$i});
395 :     } else {
396 :     $K += $i;
397 :     }
398 :     }
399 : apizer 1079
400 : sh002i 1050 # my $N = @{ $self->{questions} };
401 :     my @remaining = complement( [0..$N-1], [@fixed_choices] );
402 : apizer 1079
403 : sh002i 1050 my @slice = @fixed_choices;
404 :     push (@slice, @remaining[ $self->NchooseK(scalar(@remaining), $K) ] ); #slice of remaing choices
405 :     @slice = @slice[ $self->NchooseK( scalar(@slice), scalar(@slice) ) ]; #randomize the slice (the questions)
406 : apizer 1079
407 : sh002i 1050 #shuffle will be used to randomize the answers a second time (so they don't coincide with the questions)
408 :     my @shuffle = $self->NchooseK( scalar(@slice), scalar(@slice) );
409 : apizer 1079
410 : sh002i 1050 $self->{slice} = \@slice; #keep track of the slice and shuffle
411 : apizer 1079 $self->{shuffle} = \@shuffle;
412 : sh002i 1050 }
413 :    
414 :     #select questions and answers according to slice and shuffle
415 :     sub selectQA {
416 :     my $self = shift;
417 : apizer 1079
418 : sh002i 1050 $self->{selected_q} = [ @{ $self->{questions} }[ @{ $self->{slice} } ] ];
419 :     $self->{selected_a} = [ @{ $self->{answers} }[@{ $self->{slice} }[@{ $self->{shuffle} } ] ] ];
420 :     $self->{inverted_shuffle} = [ invert(@{ $self->{shuffle} }) ];
421 :     }
422 :    
423 :     #dump unused answers into list of extra answers
424 :     sub dumpExtra {
425 :     my $self = shift;
426 :     my @more_extras = complement([0..scalar(@{ $self->{answers} })-1], [@{ $self->{slice} }]);
427 :     push( @{ $self->{extras} }, @{ $self->{answers} }[@more_extras] );
428 :     }
429 :    
430 :     #Allows answers to be added to the end of the selected answers
431 : apizer 1079 #This can be used to force answers like "None of the above" and/or "All of the above" to still occur at the
432 : sh002i 1050 #end of the list instead of being randomized like the rest of the answers
433 :     sub makeLast {
434 :     my $self = shift;
435 :     my @input = @_;
436 : apizer 1079
437 : sh002i 1050 push(@{ $self->{selected_a} }, @input);
438 :     $self->condense(); #make sure that the user has not accidentally forced a duplicate answer
439 : apizer 1079 #note: condense was changed to eliminate the first occurence of a duplicate
440 : sh002i 1050 #instead of the last occurence so that it could be used in this case and
441 :     #would not negate the fact that one of the answers needs to be at the end
442 :     }
443 :    
444 : apizer 1079 #Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer
445 : sh002i 1050 #point to one and only one copy of that answer
446 :     sub old_condense {
447 :     my $self = shift;
448 :     for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) {
449 :     for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) {
450 :     if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) {
451 :     #then delete the duplicate answer at subscript $outer
452 :     @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer+1..$#{ $self->{selected_a} }] );
453 : apizer 1079
454 : sh002i 1050 #the values of inverted_shuffle point to the position elements in selected_a
455 :     #so in order to delete something from selected_a, each element with a position
456 :     #greater than $outer must have its position be decremented by one
457 :     $inner--; #$inner must be greater than outer so decrement $inner first
458 :     for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
459 :     if ( @{ $self->{inverted_shuffle} }[$pos] == $outer ) {
460 :     @{ $self->{inverted_shuffle} }[$pos] = $inner;
461 :     } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
462 :     @{ $self->{inverted_shuffle} }[$pos]--;
463 :     }
464 :     }
465 : apizer 1079 #we just changed a bunch of pointers so we need to go back over the same answers again
466 : sh002i 1050 #(so we decrement $inner (which we already did) and $outer to counter-act the for loop))
467 :     #this could probably be done slightly less hackish with while loops instead of for loops
468 :     #$outer--;
469 :     }
470 :     }
471 :     }
472 :     }
473 :    
474 :     #re-written RDV 10/4/2000
475 :     #Eliminates duplicate answers and rearranges inverted_shuffle so that all questions with the same answer
476 :     #point to one and only one copy of that answer
477 :     sub condense {
478 :     my $self = shift;
479 :     my ($outer, $inner) = (0, 0);
480 :     my $repeat = 0;
481 :    
482 :     while ($outer < @{ $self->{selected_a} }) {
483 :     $inner = $outer + 1;
484 :     $repeat = 0; #loop again if we find a match
485 :     while ($inner < @{ $self->{selected_a}}) {
486 :     $repeat = 0; #loop again if we find a match
487 :     if (@{ $self->{selected_a} }[$outer] eq @{$self->{selected_a} }[$inner]) {
488 :    
489 :     #then delete the duplicate answer at subscript $outer by combining everything before and after it
490 :     @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer+1..$#{ $self->{selected_a} }] );
491 :    
492 :     #the values of inverted_shuffle to point the _subscript_ of elements in selected_a
493 :     #so in order to delete something from selected_a, each element with a subscript
494 :     #greater than $outer (where the deletion occurred) must have its position decremented by one
495 :     #This also means we need to "slide" $inner down so that it points to the new position
496 :     #of the duplicate answer
497 :     $inner--;
498 :    
499 :     for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
500 :     if ( @{ $self->{inverted_shuffle} }[$pos] == $outer) {
501 :     @{ $self->{inverted_shuffle} }[$pos] = $inner;
502 :     } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
503 :     @{ $self->{inverted_shuffle} }[$pos]--;
504 :     }
505 :     }
506 :    
507 :     #because we just changed the element that $outer points to
508 :     #we need to run throught the loop to make sure that the new value at $outer has
509 :     #no duplicates as well
510 :     #This means that we don't want to increment either counter (and we need to reset $inner)
511 :     $repeat = 1;
512 : apizer 1079 $inner = $outer + 1;
513 : sh002i 1050 }
514 :     $inner++ unless $repeat;
515 :     }
516 :     $outer++ unless $repeat;
517 :     }
518 :     }
519 :    
520 :    
521 :     # This condense didn't repeat the inner loop after deleting the element at $outer (so that $outer now pointed to a new value)
522 :     # so if the new value at $outer also had a duplicate then it was just skipped.
523 :     # This shouldn't work but i'll leave it in for a while just in case
524 :    
525 :     ##Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer
526 :     ##point to one and only one copy of that answer
527 : apizer 1079 #sub old_condense {
528 : sh002i 1050 # my $self = shift;
529 :     # for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) {
530 :     # for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) {
531 :     # if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) {
532 :     # #then delete the duplicate answer at subscript $outer
533 :     # @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer
534 :     #
535 :     # #the values of inverted_shuffle point to the position elements in selected_a
536 :     # #so in order to delete something from selected_a, each element with a position
537 :     # #greater than $outer must have its position be decremented by one
538 :     # $inner--; #$inner must be greater than outer so decrement $inner first
539 :     # for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
540 :     # if ( @{ $self->{inverted_shuffle} }[$pos] == $outer ) {
541 :     # @{ $self->{inverted_shuffle} }[$pos] = $inner;
542 :     # } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
543 :     # @{ $self->{inverted_shuffle} }[$pos]--;
544 :     # }
545 :     # }
546 :     # }
547 :     # }
548 :     # }
549 :     #}
550 : gage 4827 # sub pretty_print {
551 :     # my $r_input = shift;
552 :     # my $out = '';
553 :     # if ( not ref($r_input) ) {
554 :     # $out = $r_input; # not a reference
555 :     # } elsif ("$r_input" =~/hash/i ) { # this will pick up objects whose '$self' is hash and so works better than ref($r_iput).
556 :     # local($^W) = 0;
557 :     # $out .= "$r_input " ."<TABLE border = \"2\" cellpadding = \"3\" BGCOLOR = \"#FFFFFF\">";
558 : sh002i 1050 # foreach my $key (sort keys %$r_input ) {
559 :     # $out .= "<tr><TD> $key</TD><TD> =&gt; </td><td>".pretty_print($r_input->{$key}) . "</td></tr>";
560 :     # }
561 :     # $out .="</table>";
562 : gage 4827 # } elsif (ref($r_input) eq 'ARRAY' ) {
563 :     # my @array = @$r_input;
564 :     # $out .= "( " ;
565 :     # while (@array) {
566 :     # $out .= pretty_print(shift @array) . " , ";
567 :     # }
568 :     # $out .= " )";
569 :     # } elsif (ref($r_input) eq 'CODE') {
570 :     # $out = "$r_input";
571 :     # # } elsif (ref($r_input) =~/list/i or ref($r_input) =~/match/i or ref($r_input) =~/multiple/i) {
572 :     # # local($^W) = 0;
573 :     # # $out .= ref($r_input) . " <BR>" ."<TABLE BGCOLOR = \"#FFFFFF\">";
574 :     # # foreach my $key (sort keys %$r_input ) {
575 :     # # $out .= "<tr><TD> $key</TD><TD> =&gt; </td><td>".pretty_print($r_input->{$key}) . "</td></tr>";
576 :     # # }
577 :     # # $out .="</table>";
578 :     # } else {
579 :     # $out = $r_input;
580 :     # }
581 :     # $out;
582 :     # }
583 : sh002i 1050
584 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9