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

View of /trunk/pg/lib/ChoiceList.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 6346 - (download) (as text) (annotate)
Sat Jul 10 12:39:40 2010 UTC (8 years, 5 months ago) by gage
File size: 21300 byte(s)
Merging changes gage branch  gage_dev/pg

removed dependence on AUTOLOAD	which does not work well with newer versions of Safe.pm.  It wasn't needed 
in any case.  There remain other incompatibilies of WeBWorK with Safe.pm 2.27

Added more support for WARN_MESSAGE  and DEBUG_MESSAGE

Changed List.pm to ChoiceList.pm  to remove confusion with MathObjects List object

Additional support for geogebra applets



    1 
    2 #New highly object-oriented ChoiceList construct
    3 #This ChoiceList.pm is the super class for all types of ChoiceLists
    4 #As of 6/5/2000 the three ChoiceList sub-classes are Match, Select, Multiple
    5 #RDV
    6 
    7 =head1 NAME
    8 
    9   ChoiceList.pm  -- super-class for all ChoiceList structures
   10 
   11 =head1 SYNOPSIS
   12 
   13 =pod
   14 
   15 ChoiceList.pm is not intended to be used as a stand alone object.
   16 
   17 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 questions that involve some sort of list of questions and/or answers.
   20 
   21 ChoiceList.pm has been used to construct Match.pm, Select.pm, and Multiple.pm.
   22 
   23 These three classes are objects that can be used to create the
   24 following question types:
   25 
   26 B<Matching list:>
   27 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 the answer to #1 is A).
   33 
   34 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 
   41 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 (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 =head2 Variables and methods available to sub-classes
   55 
   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 
   62   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 
   66   ans_rule_len      # determines the length of the answer blanks
   67               # default is 4
   68 
   69   slice         # index used to select specific questions
   70   shuffle         # permutation array which can be applied to slice
   71               # to shuffle the answers
   72 
   73   inverted_shuffle    # the inverse permutation array
   74 
   75   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 
   83   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 
   91   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 
   97   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   qa( array )       # accepts an array of strings which can be used
  103               # for questions and answers
  104 
  105   extra( array )      # accepts an array of strings which can be used
  106               # as extra answers
  107 
  108   print_q         # yields a formatted string of question to be
  109               # matched with answer blanks
  110   print_a         # yields a formatted string of answers
  111 
  112   choose([3, 4], 1)   # chooses questions indexed 3 and 4 and one other
  113               # randomly
  114   choose_extra([3, 4], 1) # choooses extra answers indexed 3 and 4 and one
  115               # other
  116   makeLast( array )   # accepts an array of strings (like qa) which will
  117               # be forced to the end of the list of answers.
  118 
  119   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 ChoiceList;
  135 
  136 
  137 
  138 @ChoiceList::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 
  162   warn "ChoiceList requires a random number: new ChoiceList(random(1,2000,1)" unless defined $seed;
  163 
  164   my $self = {  _permitted => \%fields,
  165 
  166         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 
  182   bless $self, $class;
  183 
  184   $self->{rand_gen}->srand($seed);
  185 
  186   $self->{rf_print_q} = shift;
  187   $self->{rf_print_a} = shift;
  188 
  189   return $self;
  190 }
  191 
  192 # AUTOLOAD allows variables to be set and accessed like methods
  193 # 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 #
  198 #   # $AUTOLOAD is sent in by Perl and is the full name of the object (i.e. main::blah::blah_more)
  199 #   my $name = $ChoiceList::AUTOLOAD;
  200 #   $name =~ s/.*://; #strips fully-qualified portion
  201 #
  202 #   unless ( exists $self->{'_permitted'}->{$name} ) {
  203 #     die "Can't find '$name' field in object of class '$type'";
  204 #   }
  205 #
  206 #   if (@_) {
  207 #     return $self->{$name} = shift; #set the variable to the first parameter
  208 #   } 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 #internal
  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 
  229   my @array = 0..($n-1);
  230   my @out = ();
  231 
  232   while (@out < $k) {
  233     push(@out, splice(@array, $self->{rand_gen}->random(0, $#array, 1), 1) );
  234   }
  235 
  236   return @out;
  237 }
  238 #internal
  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 
  245   return @out;
  246 }
  247 
  248 
  249 # *** Utility subroutines ***
  250 
  251 #internal
  252 #swap subscripts with their respective values
  253 sub invert {
  254   my @array = @_;
  255   my @out = ();
  256 
  257   for (my $i=0; $i<@array; $i++) {
  258     $out[$array[$i]] = $i;
  259   }
  260 
  261   return @out;
  262 }
  263 #internal
  264 #slice of the alphabet
  265 sub ALPHABET {
  266   return ('A'..'ZZ')[@_];
  267 }
  268 
  269 #given a universe of subscripts and a subset of the universe,
  270 #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 
  277   my %set = ();
  278 
  279   foreach my $i (@set) {
  280     $set{$i} = 1;
  281   }
  282 
  283   my @out = ();
  284 
  285   foreach my $i (@univ) {
  286     push(@out, $i) unless exists( $set{$i} );
  287   }
  288 
  289   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 
  300 =head3    qa
  301        Usage:    $ml->qa( qw( question1 answer1 question2 answer2   ) );
  302 
  303 =cut
  304 
  305 sub qa {
  306   my $self = shift;
  307   my @questANDanswer = @_;
  308 
  309   while (@questANDanswer) {
  310     push (@{ $self->{questions} }, shift(@questANDanswer) );
  311     push (@{ $self->{answers} },   shift(@questANDanswer) );
  312   }
  313 }
  314 
  315 #Input extra answers  -- not to be confused with access method extras below
  316 sub extra {
  317   my $self = shift;
  318   push(@{ $self->{extras} }, @_); #pushing allows multiple calls without overwriting old "extras"
  319 }
  320 
  321 
  322 #Output questions
  323 #Doesn't do actual output, refers to method given in call to 'new' (rf_print_q)
  324 
  325 sub print_q {
  326   my $self = shift;
  327 
  328   &{ $self->{rf_print_q} }( $self, @{ $self->{selected_q} } );
  329 }
  330 
  331 #Output answers
  332 #Doesn't do actual output, refers to method given in call to 'new' (rf_print_a)
  333 sub print_a {
  334   my $self = shift;
  335 
  336   &{ $self->{rf_print_a} }( $self, @{ $self->{selected_a} } );
  337 }
  338 
  339 #return array of answers to be checked against the students answers
  340 #defaults to returning the actual selected answers (should be overloaded for other types of answers)
  341 sub ra_correct_ans {
  342   my $self = shift;
  343   return $self->{selected_a};
  344 }
  345 
  346 =head3 cmp
  347 
  348   Usage    ANS($ml -> cmp);
  349 
  350 provides a MathObject like comparison method
  351 returns a string of comparison methods for checking the list object
  352 
  353 =cut
  354 
  355 sub cmp {
  356   my $self = shift;
  357   my @answers = @{$self->{selected_a}};
  358   @answers = map {Value::makeValue($_)} @answers; # make sure answers are all MathObjects
  359   @answers = map {$_->cmp} @answers;              # replace the MathObjects by their AnswerEvaluators
  360   return @answers;
  361 }
  362 
  363 #Match and Select return references to arrays while Multiple justs returns a string
  364 #so Match and Select use ra_correct_ans while Multiple uses correct_ans
  365 sub correct_ans {
  366   warn "Match and/or Select do not use correct_ans.\nYou should use ra_correct_ans instead.";
  367 }
  368 
  369 # *** Question and Answer Manipulation Subroutines ***
  370 
  371 
  372 #calls methods that deal with list specific methods of picking random questions and answers
  373 #mainly exists for backward compatibility and to hide some of the activity from the naive user
  374 sub choose {
  375   my $self = shift;
  376   my @input = @_;
  377 
  378   $self->getRandoms(scalar(@{$self->{questions}}), @input); #pick random numbers
  379   $self->selectQA();      #select questions and answers
  380   $self->dumpExtra();     #dump extra answers into "extras"
  381   $self->condense();      #eliminate duplicate answers"
  382 }
  383 
  384 #randomly inserts the selected extra answers into selected_a and
  385 #updates inverted_shuffle accordingly
  386 sub choose_extra {
  387   my $self = shift;
  388   my @input = @_;
  389 
  390   $self->getRandoms(scalar(@{ $self->{extras} }), @input);
  391   $self->{selected_e} = [ @{ $self->{extras} }[ @{ $self->{slice} }[ @{ $self->{shuffle} } ] ] ];
  392   my $length = 0;
  393 
  394   my $random = 0;
  395   foreach my $extra_ans ( invert(@{ $self->{shuffle} }) ) {
  396     #warn "Selected Answers: @{ $self->{selected_a} }<BR>
  397     #      Inverted Shuffle: @{ $self->{inverted_shuffle} }<BR>
  398     #      Random: $random";
  399     $random = $self->{rand_gen}->random(0, scalar(@{ $self->{selected_a} }), 1);
  400     for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
  401       @{ $self->{inverted_shuffle} }[$pos]++ unless @{ $self->{inverted_shuffle} }[$pos] < $random;
  402     }
  403     my @temp = ( @{ $self->{selected_a} }[0..$random-1], @{ $self->{selected_e} }[$extra_ans], @{$self->{selected_a} }[$random..$#{ $self->{selected_a} } ] );
  404     @{ $self->{selected_a} } = @temp;
  405   }
  406 }
  407 
  408 #create random @slice and @shuffle to randomize questions and answers
  409 sub getRandoms {
  410   my $self = shift;
  411   my $N = shift;
  412   my @input = @_;
  413   my $K = 0;
  414 
  415   my @fixed_choices = (); # questions forced by the user
  416   foreach my $i (@input) { #input is of the form ([3, 5, 6], 3)
  417     if (ref($i) eq 'ARRAY') {
  418       push(@fixed_choices, @{$i});
  419     } else {
  420       $K += $i;
  421     }
  422   }
  423 
  424 # my $N = @{ $self->{questions} };
  425   my @remaining = complement( [0..$N-1], [@fixed_choices] );
  426 
  427   my @slice = @fixed_choices;
  428   push (@slice, @remaining[ $self->NchooseK(scalar(@remaining), $K) ] ); #slice of remaing choices
  429   @slice = @slice[ $self->NchooseK( scalar(@slice), scalar(@slice) ) ]; #randomize the slice (the questions)
  430 
  431   #shuffle will be used to randomize the answers a second time (so they don't coincide with the questions)
  432   my @shuffle = $self->NchooseK( scalar(@slice), scalar(@slice) );
  433 
  434   $self->{slice} = \@slice; #keep track of the slice and shuffle
  435   $self->{shuffle} = \@shuffle;
  436 }
  437 
  438 #select questions and answers according to slice and shuffle
  439 sub selectQA {
  440   my $self = shift;
  441 
  442   $self->{selected_q} = [ @{ $self->{questions} }[ @{ $self->{slice} } ] ];
  443   $self->{selected_a} = [ @{ $self->{answers} }[@{ $self->{slice} }[@{ $self->{shuffle} } ] ] ];
  444   $self->{inverted_shuffle} = [ invert(@{ $self->{shuffle} }) ];
  445 }
  446 
  447 #dump unused answers into list of extra answers
  448 sub dumpExtra {
  449   my $self = shift;
  450   my @more_extras = complement([0..scalar(@{ $self->{answers} })-1], [@{ $self->{slice} }]);
  451   push( @{ $self->{extras} }, @{ $self->{answers} }[@more_extras] );
  452 }
  453 
  454 #Allows answers to be added to the end of the selected answers
  455 #This can be used to force answers like "None of the above" and/or "All of the above" to still occur at the
  456 #end of the list instead of being randomized like the rest of the answers
  457 sub makeLast {
  458   my $self = shift;
  459   my @input = @_;
  460 
  461   push(@{ $self->{selected_a} }, @input);
  462   $self->condense();  #make sure that the user has not accidentally forced a duplicate answer
  463         #note: condense was changed to eliminate the first occurence of a duplicate
  464         #instead of the last occurence so that it could be used in this case and
  465         #would not negate the fact that one of the answers needs to be at the end
  466 }
  467 
  468 #Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer
  469 #point to one and only one copy of that answer
  470 # sub old_condense {
  471 #   my $self = shift;
  472 #   for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) {
  473 #     for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) {
  474 #       if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) {
  475 #         #then delete the duplicate answer at subscript $outer
  476 #         @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer+1..$#{ $self->{selected_a} }] );
  477 #
  478 #         #the values of inverted_shuffle point to the position elements in selected_a
  479 #         #so in order to delete something from selected_a, each element with a position
  480 #         #greater than $outer must have its position be decremented by one
  481 #         $inner--; #$inner must be greater than outer so decrement $inner first
  482 #         for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
  483 #           if ( @{ $self->{inverted_shuffle} }[$pos] == $outer ) {
  484 #             @{ $self->{inverted_shuffle} }[$pos] = $inner;
  485 #           } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
  486 #             @{ $self->{inverted_shuffle} }[$pos]--;
  487 #           }
  488 #         }
  489 #         #we just changed a bunch of pointers so we need to go back over the same answers again
  490 #         #(so we decrement $inner (which we already did) and $outer to counter-act the for loop))
  491 #         #this could probably be done slightly less hackish with while loops instead of for loops
  492 #         #$outer--;
  493 #       }
  494 #     }
  495 #   }
  496 # }
  497 
  498 #re-written RDV 10/4/2000
  499 #Eliminates duplicate answers and rearranges inverted_shuffle so that all questions with the same answer
  500 #point to one and only one copy of that answer
  501 sub condense {
  502   my $self = shift;
  503   my ($outer, $inner) = (0, 0);
  504   my $repeat = 0;
  505 
  506   while ($outer < @{ $self->{selected_a} }) {
  507     $inner = $outer + 1;
  508     $repeat = 0; #loop again if we find a match
  509     while ($inner < @{ $self->{selected_a}}) {
  510       $repeat = 0; #loop again if we find a match
  511       if (@{ $self->{selected_a} }[$outer] eq @{$self->{selected_a} }[$inner]) {
  512 
  513         #then delete the duplicate answer at subscript $outer by combining everything before and after it
  514         @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer+1..$#{ $self->{selected_a} }] );
  515 
  516         #the values of inverted_shuffle to point the _subscript_ of elements in selected_a
  517         #so in order to delete something from selected_a, each element with a subscript
  518         #greater than $outer (where the deletion occurred) must have its position decremented by one
  519         #This also means we need to "slide" $inner down so that it points to the new position
  520         #of the duplicate answer
  521         $inner--;
  522 
  523         for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
  524           if ( @{ $self->{inverted_shuffle} }[$pos] == $outer) {
  525             @{ $self->{inverted_shuffle} }[$pos] = $inner;
  526           } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
  527             @{ $self->{inverted_shuffle} }[$pos]--;
  528           }
  529         }
  530 
  531         #because we just changed the element that $outer points to
  532         #we need to run throught the loop to make sure that the new value at $outer has
  533         #no duplicates as well
  534         #This means that we don't want to increment either counter (and we need to reset $inner)
  535         $repeat = 1;
  536         $inner = $outer + 1;
  537       }
  538       $inner++ unless $repeat;
  539     }
  540     $outer++ unless $repeat;
  541   }
  542 }
  543 
  544 ##########################
  545 # Access methods
  546 ##########################
  547 sub questions {
  548   my $self = shift;
  549   my $type = ref($self) || die "$self is not an object";
  550   unless (exists $self->{questions} ) {
  551     die "Can't find questions field in object of class $type";
  552   }
  553 
  554   if (@_) {
  555     return $self->{questions} = shift;
  556   } else {
  557     return $self->{questions}
  558   }
  559 }
  560 
  561 sub answers {
  562   my $self = shift;
  563   my $type = ref($self) || die "$self is not an object";
  564   unless (exists $self->{answers} ) {
  565     die "Can't find answers field in object of class $type";
  566   }
  567 
  568   if (@_) {
  569     return $self->{answers} = shift;
  570   } else {
  571     return $self->{answers}
  572   }
  573 }
  574 sub extras {
  575   my $self = shift;
  576   my $type = ref($self) || die "$self is not an object";
  577   unless (exists $self->{extras} ) {
  578     die "Can't find extras field in object of class $type";
  579   }
  580 
  581   if (@_) {
  582     return $self->{extras} = shift;
  583   } else {
  584     return $self->{extras}
  585   }
  586 }
  587 sub selected_q {
  588   my $self = shift;
  589   my $type = ref($self) || die "$self is not an object";
  590   unless (exists $self->{selected_q} ) {
  591     die "Can't find selected_q field in object of class $type";
  592   }
  593 
  594   if (@_) {
  595     return $self->{selected_q} = shift;
  596   } else {
  597     return $self->{selected_q}
  598   }
  599 }
  600 sub selected_a {
  601   my $self = shift;
  602   my $type = ref($self) || die "$self is not an object";
  603   unless (exists $self->{selected_a} ) {
  604     die "Can't find selected_a field in object of class $type";
  605   }
  606 
  607   if (@_) {
  608     return $self->{selected_a} = shift;
  609   } else {
  610     return $self->{selected_a}
  611   }
  612 }
  613 sub selected_e {
  614   my $self = shift;
  615   my $type = ref($self) || die "$self is not an object";
  616   unless (exists $self->{selected_e} ) {
  617     die "Can't find selected_e field in object of class $type";
  618   }
  619 
  620   if (@_) {
  621     return $self->{selected_e} = shift;
  622   } else {
  623     return $self->{selected_e}
  624   }
  625 }
  626 sub ans_rule_len {
  627   my $self = shift;
  628   my $type = ref($self) || die "$self is not an object";
  629   unless (exists $self->{ans_rule_len} ) {
  630     die "Can't find ans_rule_len field in object of class $type";
  631   }
  632 
  633   if (@_) {
  634     return $self->{ans_rule_len} = shift;
  635   } else {
  636     return $self->{ans_rule_len}
  637   }
  638 }
  639 sub ra_pop_up_list {
  640   my $self = shift;
  641   my $type = ref($self) || die "$self is not an object";
  642   unless (exists $self->{ra_pop_up_list} ) {
  643     die "Can't find ra_pop_up_list field in object of class $type";
  644   }
  645 
  646   if (@_) {
  647     return $self->{ra_pop_up_list} = shift;
  648   } else {
  649     return $self->{ra_pop_up_list}
  650   }
  651 }
  652 sub rf_print_q {
  653   my $self = shift;
  654   my $type = ref($self) || die "$self is not an object";
  655   unless (exists $self->{rf_print_q} ) {
  656     die "Can't find rf_print_q field in object of class $type";
  657   }
  658 
  659   if (@_) {
  660     return $self->{rf_print_q} = shift;
  661   } else {
  662     return $self->{rf_print_q}
  663   }
  664 }
  665 sub rf_print_a {
  666   my $self = shift;
  667   my $type = ref($self) || die "$self is not an object";
  668   unless (exists $self->{rf_print_a} ) {
  669     die "Can't find rf_print_a field in object of class $type";
  670   }
  671 
  672   if (@_) {
  673     return $self->{rf_print_a} = shift;
  674   } else {
  675     return $self->{rf_print_a}
  676   }
  677 }
  678 sub slice {
  679   my $self = shift;
  680   my $type = ref($self) || die "$self is not an object";
  681   unless (exists $self->{slice} ) {
  682     die "Can't find slice field in object of class $type";
  683   }
  684 
  685   if (@_) {
  686     return $self->{slice} = shift;
  687   } else {
  688     return $self->{slice}
  689   }
  690 }
  691 
  692 sub inverted_shuffle {
  693   my $self = shift;
  694   my $type = ref($self) || die "$self is not an object";
  695   unless (exists $self->{inverted_shuffle} ) {
  696     die "Can't find inverted_shuffle field in object of class $type";
  697   }
  698 
  699   if (@_) {
  700     return $self->{inverted_shuffle} = shift;
  701   } else {
  702     return $self->{inverted_shuffle}
  703   }
  704 }
  705 sub rand_gen {
  706   my $self = shift;
  707   my $type = ref($self) || die "$self is not an object";
  708   unless (exists $self->{rand_gen} ) {
  709     die "Can't find rand_gen field in object of class $type";
  710   }
  711 
  712   if (@_) {
  713     return $self->{rand_gen} = shift;
  714   } else {
  715     return $self->{rand_gen}
  716   }
  717 }
  718 
  719 
  720 
  721 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9