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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 1050 Revision 1079
1#!/usr/bin/perl -w 1
2#New highly object-oriented list construct 2#New highly object-oriented list construct
3#This List.pm is the super class for all types of lists 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 4#As of 6/5/2000 the three list sub-classes are Match, Select, Multiple
5#RDV 5#RDV
6 6
12 12
13=pod 13=pod
14 14
15List.pm is not intended to be used as a stand alone object. 15List.pm is not intended to be used as a stand alone object.
16 16
17It is a super-class designed to be inherited by sub-classes that, 17It is a super-class designed to be inherited by sub-classes that,
18through small changes, can be used for a variety of different 18through small changes, can be used for a variety of different
19questions that involve some sort of list of questions and/or answers. 19questions that involve some sort of list of questions and/or answers.
20 20
21List.pm has been used to construct Match.pm, Select.pm, and Multiple.pm. 21List.pm has been used to construct Match.pm, Select.pm, and Multiple.pm.
22 22
23These three classes are objects that can be used to create the 23These three classes are objects that can be used to create the
24following question types: 24following question types:
25 25
26B<Matching list:> 26B<Matching list:>
27Given a list of questions and answers, match the correct answers to the 27Given a list of questions and answers, match the correct answers to the
28questions. Some answers may be used more than once and some may not be used at 28questions. Some answers may be used more than once and some may not be used at
29all. The order of the answers is usually random but some answers can be 29all. The order of the answers is usually random but some answers can be
30appended to the end in a set order (i.e. 'None of the above'). Answers are 30appended to the end in a set order (i.e. 'None of the above'). Answers are
31given corresponding letters as shortcuts to typing in the full answer. (i.e. 31given corresponding letters as shortcuts to typing in the full answer. (i.e.
32the answer to #1 is A). 32the answer to #1 is A).
33 33
34B<Select list:> 34B<Select list:>
35Given a list of questions and (usually) implied answers, give the correct 35Given a list of questions and (usually) implied answers, give the correct
36answer to each question. This is intended mainly for true/false questions or 36answer to each question. This is intended mainly for true/false questions or
37other types of questions where the answers are short and can therefore be typed 37other types of questions where the answers are short and can therefore be typed
38in by the user easily. If a select list is desired but the answers are too long 38in by the user easily. If a select list is desired but the answers are too long
39to really type in, a popup-list of the answers can be used. 39to really type in, a popup-list of the answers can be used.
40 40
41B<Multiple choice:> 41B<Multiple choice:>
42Given a single question and a list of answers, select the single correct answer. 42Given a single question and a list of answers, select the single correct answer.
43This structure creates a standard multiple choice question as would be seen on a 43This structure creates a standard multiple choice question as would be seen on a
44standardize test. Extra answers are entered along with the question in a simple 44standardize test. Extra answers are entered along with the question in a simple
45format and (as with Match.pm), if necessary, can be appended in order at the end 45format and (as with Match.pm), if necessary, can be appended in order at the end
46(i.e. 'None of the above') 46(i.e. 'None of the above')
47 47
48=for html 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> 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 50
51 51
52=head1 DESCRIPTION 52=head1 DESCRIPTION
53 53
54=head2 Variables and methods available to sub-classes 54=head2 Variables and methods available to sub-classes
55 55
56=head3 Variables 56=head3 Variables
57 57
58 questions # array of questions as entered using qa() 58 questions # array of questions as entered using qa()
59 answers # array of answers as entered using qa() 59 answers # array of answers as entered using qa()
60 extras # array of extras as entered using extra() 60 extras # array of extras as entered using extra()
61 61
62 selected_q # randomly selected subset of "questions" 62 selected_q # randomly selected subset of "questions"
63 selected_a # the answers for the selected questions 63 selected_a # the answers for the selected questions
64 selected_e # randomly selected subset of "extras" 64 selected_e # randomly selected subset of "extras"
65 65
66 ans_rule_len # determines the length of the answer blanks 66 ans_rule_len # determines the length of the answer blanks
67 # default is 4 67 # default is 4
68 68
69 slice # index used to select specific questions 69 slice # index used to select specific questions
70 shuffle # permutation array which can be applied to slice 70 shuffle # permutation array which can be applied to slice
71 # to shuffle the answers 71 # to shuffle the answers
72 72
73 inverted_shuffle # the inverse permutation array 73 inverted_shuffle # the inverse permutation array
74 74
75 rf_print_q # reference to any subroutine which should 75 rf_print_q # reference to any subroutine which should
76 # take ($self, @questions) as parameters and 76 # take ($self, @questions) as parameters and
77 # output the questions in a formatted string. 77 # output the questions in a formatted string.
78 # If you want to change the way questions are 78 # If you want to change the way questions are
79 # printed, write your own print method and set 79 # printed, write your own print method and set
80 # this equal to a reference to to that method 80 # this equal to a reference to to that method
81 # (i.e. $sl->rf_print_q = ~~&printing_routine_q) 81 # (i.e. $sl->rf_print_q = ~~&printing_routine_q)
82 82
83 rf_print_a # reference to any subroutine which should 83 rf_print_a # reference to any subroutine which should
84 # take ($self, @answers) as parameters and 84 # take ($self, @answers) as parameters and
85 # output the answers in a formatted string. 85 # output the answers in a formatted string.
86 # If you want to change the way answers are 86 # If you want to change the way answers are
87 # printed, write your own print method and set 87 # printed, write your own print method and set
88 # this equal to a reference to to that method 88 # this equal to a reference to to that method
89 # (i.e. $sl->rf_print_a = ~~&printing_routine_a) 89 # (i.e. $sl->rf_print_a = ~~&printing_routine_a)
90 90
91 ra_pop_up_list # Field used in sub classes that use pop_up_list_print_q 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 92 # to format the questions. (Placing a pop_up_list next to
93 # each question instead of an answer blank. 93 # each question instead of an answer blank.
94 # It is initialized to 94 # It is initialized to
95 # => [no_answer =>' ?', T => 'True', F => 'False'] 95 # => [no_answer =>' ?', T => 'True', F => 'False']
96 96
97 ans_rule_len # field which can be used in the question printing routines 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. 98 # to determine the length of the answer blanks before the questions.
99 99
100=head3 Methods 100=head3 Methods
101 101
102 qa( array ) # accepts an array of strings which can be used 102 qa( array ) # accepts an array of strings which can be used
103 # for questions and answers 103 # for questions and answers
104 104
105 extra( array ) # accepts an array of strings which can be used 105 extra( array ) # accepts an array of strings which can be used
106 # as extra answers 106 # as extra answers
107 107
108 print_q # yields a formatted string of question to be 108 print_q # yields a formatted string of question to be
109 # matched with answer blanks 109 # matched with answer blanks
110 print_a # yields a formatted string of answers 110 print_a # yields a formatted string of answers
111 111
112 choose([3, 4], 1) # chooses questions indexed 3 and 4 and one other 112 choose([3, 4], 1) # chooses questions indexed 3 and 4 and one other
113 # randomly 113 # randomly
114 choose_extra([3, 4], 1) # choooses extra answers indexed 3 and 4 and one 114 choose_extra([3, 4], 1) # choooses extra answers indexed 3 and 4 and one
115 # other 115 # other
116 makeLast( array ) # accepts an array of strings (like qa) which will 116 makeLast( array ) # accepts an array of strings (like qa) which will
117 # be forced to the end of the list of answers. 117 # be forced to the end of the list of answers.
118 118
119 ra_correct_ans # outputs a reference to the array of correct answers 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) 120 correct_ans # outputs a concatenated string of correct answers (only for Multiple)
121 121
122=head2 Usage 122=head2 Usage
123 123
156 156
157#used to initialize variables and create an instance of the class 157#used to initialize variables and create an instance of the class
158sub new { 158sub new {
159 my $class = shift; 159 my $class = shift;
160 my $seed = shift; 160 my $seed = shift;
161 161
162 warn "List requires a random number: new List(random(1,2000,1)" unless defined $seed; 162 warn "List requires a random number: new List(random(1,2000,1)" unless defined $seed;
163 163
164 my $self = { _permitted => \%fields, 164 my $self = { _permitted => \%fields,
165 165
166 questions => [], 166 questions => [],
167 answers => [], 167 answers => [],
168 extras => [], 168 extras => [],
169 selected_q => [], 169 selected_q => [],
170 selected_a => [], 170 selected_a => [],
176 slice => [], 176 slice => [],
177 shuffle => [], 177 shuffle => [],
178 inverted_shuffle => [], 178 inverted_shuffle => [],
179 rand_gen => new PGrandom, 179 rand_gen => new PGrandom,
180 }; 180 };
181 181
182 bless $self, $class; 182 bless $self, $class;
183 183
184 $self->{rand_gen}->srand($seed); 184 $self->{rand_gen}->srand($seed);
185 185
186 $self->{rf_print_q} = shift; 186 $self->{rf_print_q} = shift;
187 $self->{rf_print_a} = shift; 187 $self->{rf_print_a} = shift;
188 188
189 return $self; 189 return $self;
190} 190}
191 191
192# AUTOLOAD allows variables to be set and accessed like methods 192# AUTOLOAD allows variables to be set and accessed like methods
193# returning the value of the variable 193# returning the value of the variable
194sub AUTOLOAD { 194sub AUTOLOAD {
195 my $self = shift; 195 my $self = shift;
196 my $type = ref($self) or die "$self is not an object"; 196 my $type = ref($self) or die "$self is not an object";
197 197
198 # $AUTOLOAD is sent in by Perl and is the full name of the object (i.e. main::blah::blah_more) 198 # $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; 199 my $name = $List::AUTOLOAD;
200 $name =~ s/.*://; #strips fully-qualified portion 200 $name =~ s/.*://; #strips fully-qualified portion
201 201
202 unless ( exists $self->{'_permitted'}->{$name} ) { 202 unless ( exists $self->{'_permitted'}->{$name} ) {
203 die "Can't find '$name' field in object of class '$type'"; 203 die "Can't find '$name' field in object of class '$type'";
204 } 204 }
205 205
206 if (@_) { 206 if (@_) {
207 return $self->{$name} = shift; #set the variable to the first parameter 207 return $self->{$name} = shift; #set the variable to the first parameter
208 } else { 208 } else {
209 return $self->{$name}; #if no parameters just return the value 209 return $self->{$name}; #if no parameters just return the value
210 } 210 }
211} 211}
212 212
223 my $self = shift; 223 my $self = shift;
224 my ($n, $k) = @_; 224 my ($n, $k) = @_;
225 225
226 die "method NchooseK: n = $n cannot be less than k=$k\n 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; 227 You probably did a 'choose($k)' with only $n questions!" if $k > $n;
228 228
229 my @array = 0..($n-1); 229 my @array = 0..($n-1);
230 my @out = (); 230 my @out = ();
231 231
232 while (@out < $k) { 232 while (@out < $k) {
233 push(@out, splice(@array, $self->{rand_gen}->random(0, $#array, 1), 1) ); 233 push(@out, splice(@array, $self->{rand_gen}->random(0, $#array, 1), 1) );
234 } 234 }
235 235
236 return @out; 236 return @out;
237} 237}
238 238
239#return an array of random numbers 239#return an array of random numbers
240sub shuffle { 240sub shuffle {
241 my $self = shift; 241 my $self = shift;
242 my $i = @_; 242 my $i = @_;
243 my @out = $self->NchooseK($i, $i); 243 my @out = $self->NchooseK($i, $i);
244 244
245 return @out; 245 return @out;
246} 246}
247 247
248 248
249# *** Utility subroutines *** 249# *** Utility subroutines ***
251 251
252#swap subscripts with their respective values 252#swap subscripts with their respective values
253sub invert { 253sub invert {
254 my @array = @_; 254 my @array = @_;
255 my @out = (); 255 my @out = ();
256 256
257 for (my $i=0; $i<@array; $i++) { 257 for (my $i=0; $i<@array; $i++) {
258 $out[$array[$i]] = $i; 258 $out[$array[$i]] = $i;
259 } 259 }
260 260
261 return @out; 261 return @out;
264#slice of the alphabet 264#slice of the alphabet
265sub ALPHABET { 265sub ALPHABET {
266 return ('A'..'ZZ')[@_]; 266 return ('A'..'ZZ')[@_];
267} 267}
268 268
269#given a universe of subscripts and a subset of the universe, 269#given a universe of subscripts and a subset of the universe,
270#return the complement of that set in the universe 270#return the complement of that set in the universe
271sub complement { 271sub complement {
272 my $ra_univ = shift; 272 my $ra_univ = shift;
273 my $ra_set = shift; 273 my $ra_set = shift;
274 my @univ = @$ra_univ; 274 my @univ = @$ra_univ;
275 my @set = @$ra_set; 275 my @set = @$ra_set;
276 276
277 my %set = (); 277 my %set = ();
278 278
279 foreach my $i (@set) { 279 foreach my $i (@set) {
280 $set{$i} = 1; 280 $set{$i} = 1;
281 } 281 }
282 282
283 my @out = (); 283 my @out = ();
284 284
285 foreach my $i (@univ) { 285 foreach my $i (@univ) {
286 push(@out, $i) unless exists( $set{$i} ); 286 push(@out, $i) unless exists( $set{$i} );
287 } 287 }
288 288
289 return @out; 289 return @out;
290} 290}
291 291
292 292
293 293
297#Input answers 297#Input answers
298#defaults to inputting 'question', 'answer', 'question', etc (should be overloaded for other types of questions) 298#defaults to inputting 'question', 'answer', 'question', etc (should be overloaded for other types of questions)
299sub qa { 299sub qa {
300 my $self = shift; 300 my $self = shift;
301 my @questANDanswer = @_; 301 my @questANDanswer = @_;
302 302
303 while (@questANDanswer) { 303 while (@questANDanswer) {
304 push (@{ $self->{questions} }, shift(@questANDanswer) ); 304 push (@{ $self->{questions} }, shift(@questANDanswer) );
305 push (@{ $self->{answers} }, shift(@questANDanswer) ); 305 push (@{ $self->{answers} }, shift(@questANDanswer) );
306 } 306 }
307} 307}
308 308
309#Input extra answers 309#Input extra answers
310sub extra { 310sub extra {
311 my $self = shift; 311 my $self = shift;
312 push(@{ $self->{extras} }, @_); #pushing allows multiple calls without overwriting old "extras" 312 push(@{ $self->{extras} }, @_); #pushing allows multiple calls without overwriting old "extras"
313} 313}
315 315
316#Output questions 316#Output questions
317#Doesn't do actual output, refers to method given in call to 'new' (rf_print_q) 317#Doesn't do actual output, refers to method given in call to 'new' (rf_print_q)
318sub print_q { 318sub print_q {
319 my $self = shift; 319 my $self = shift;
320 320
321 &{ $self->{rf_print_q} }( $self, @{ $self->{selected_q} } ); 321 &{ $self->{rf_print_q} }( $self, @{ $self->{selected_q} } );
322} 322}
323 323
324#Output answers 324#Output answers
325#Doesn't do actual output, refers to method given in call to 'new' (rf_print_a) 325#Doesn't do actual output, refers to method given in call to 'new' (rf_print_a)
326sub print_a { 326sub print_a {
327 my $self = shift; 327 my $self = shift;
328 328
329 &{ $self->{rf_print_a} }( $self, @{ $self->{selected_a} } ); 329 &{ $self->{rf_print_a} }( $self, @{ $self->{selected_a} } );
330} 330}
331 331
332#return array of answers to be checked against the students answers 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) 333#defaults to returning the actual selected answers (should be overloaded for other types of answers)
348#calls methods that deal with list specific methods of picking random questions and answers 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 349#mainly exists for backward compatibility and to hide some of the activity from the naive user
350sub choose { 350sub choose {
351 my $self = shift; 351 my $self = shift;
352 my @input = @_; 352 my @input = @_;
353 353
354 $self->getRandoms(scalar(@{$self->{questions}}), @input); #pick random numbers 354 $self->getRandoms(scalar(@{$self->{questions}}), @input); #pick random numbers
355 $self->selectQA(); #select questions and answers 355 $self->selectQA(); #select questions and answers
356 $self->dumpExtra(); #dump extra answers into "extras" 356 $self->dumpExtra(); #dump extra answers into "extras"
357 $self->condense(); #eliminate duplicate answers" 357 $self->condense(); #eliminate duplicate answers"
358} 358}
359 359
360#randomly inserts the selected extra answers into selected_a and 360#randomly inserts the selected extra answers into selected_a and
361#updates inverted_shuffle accordingly 361#updates inverted_shuffle accordingly
362sub choose_extra { 362sub choose_extra {
363 my $self = shift; 363 my $self = shift;
364 my @input = @_; 364 my @input = @_;
365 365
366 $self->getRandoms(scalar(@{ $self->{extras} }), @input); 366 $self->getRandoms(scalar(@{ $self->{extras} }), @input);
367 $self->{selected_e} = [ @{ $self->{extras} }[ @{ $self->{slice} }[ @{ $self->{shuffle} } ] ] ]; 367 $self->{selected_e} = [ @{ $self->{extras} }[ @{ $self->{slice} }[ @{ $self->{shuffle} } ] ] ];
368 my $length = 0; 368 my $length = 0;
369 369
370 my $random = 0; 370 my $random = 0;
371 foreach my $extra_ans ( invert(@{ $self->{shuffle} }) ) { 371 foreach my $extra_ans ( invert(@{ $self->{shuffle} }) ) {
372 #warn "Selected Answers: @{ $self->{selected_a} }<BR> 372 #warn "Selected Answers: @{ $self->{selected_a} }<BR>
373 # Inverted Shuffle: @{ $self->{inverted_shuffle} }<BR> 373 # Inverted Shuffle: @{ $self->{inverted_shuffle} }<BR>
374 # Random: $random"; 374 # Random: $random";
375 $random = $self->{rand_gen}->random(0, scalar(@{ $self->{selected_a} }), 1); 375 $random = $self->{rand_gen}->random(0, scalar(@{ $self->{selected_a} }), 1);
376 for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) { 376 for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
377 @{ $self->{inverted_shuffle} }[$pos]++ unless @{ $self->{inverted_shuffle} }[$pos] < $random; 377 @{ $self->{inverted_shuffle} }[$pos]++ unless @{ $self->{inverted_shuffle} }[$pos] < $random;
378 } 378 }
379 my @temp = ( @{ $self->{selected_a} }[0..$random-1], @{ $self->{selected_e} }[$extra_ans], @{$self->{selected_a} }[$random..$#{ $self->{selected_a} } ] ); 379 my @temp = ( @{ $self->{selected_a} }[0..$random-1], @{ $self->{selected_e} }[$extra_ans], @{$self->{selected_a} }[$random..$#{ $self->{selected_a} } ] );
385sub getRandoms { 385sub getRandoms {
386 my $self = shift; 386 my $self = shift;
387 my $N = shift; 387 my $N = shift;
388 my @input = @_; 388 my @input = @_;
389 my $K = 0; 389 my $K = 0;
390 390
391 my @fixed_choices = (); # questions forced by the user 391 my @fixed_choices = (); # questions forced by the user
392 foreach my $i (@input) { #input is of the form ([3, 5, 6], 3) 392 foreach my $i (@input) { #input is of the form ([3, 5, 6], 3)
393 if (ref($i) eq 'ARRAY') { 393 if (ref($i) eq 'ARRAY') {
394 push(@fixed_choices, @{$i}); 394 push(@fixed_choices, @{$i});
395 } else { 395 } else {
396 $K += $i; 396 $K += $i;
397 } 397 }
398 } 398 }
399 399
400# my $N = @{ $self->{questions} }; 400# my $N = @{ $self->{questions} };
401 my @remaining = complement( [0..$N-1], [@fixed_choices] ); 401 my @remaining = complement( [0..$N-1], [@fixed_choices] );
402 402
403 my @slice = @fixed_choices; 403 my @slice = @fixed_choices;
404 push (@slice, @remaining[ $self->NchooseK(scalar(@remaining), $K) ] ); #slice of remaing 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) 405 @slice = @slice[ $self->NchooseK( scalar(@slice), scalar(@slice) ) ]; #randomize the slice (the questions)
406 406
407 #shuffle will be used to randomize the answers a second time (so they don't coincide with the questions) 407 #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) ); 408 my @shuffle = $self->NchooseK( scalar(@slice), scalar(@slice) );
409 409
410 $self->{slice} = \@slice; #keep track of the slice and shuffle 410 $self->{slice} = \@slice; #keep track of the slice and shuffle
411 $self->{shuffle} = \@shuffle; 411 $self->{shuffle} = \@shuffle;
412} 412}
413 413
414#select questions and answers according to slice and shuffle 414#select questions and answers according to slice and shuffle
415sub selectQA { 415sub selectQA {
416 my $self = shift; 416 my $self = shift;
417 417
418 $self->{selected_q} = [ @{ $self->{questions} }[ @{ $self->{slice} } ] ]; 418 $self->{selected_q} = [ @{ $self->{questions} }[ @{ $self->{slice} } ] ];
419 $self->{selected_a} = [ @{ $self->{answers} }[@{ $self->{slice} }[@{ $self->{shuffle} } ] ] ]; 419 $self->{selected_a} = [ @{ $self->{answers} }[@{ $self->{slice} }[@{ $self->{shuffle} } ] ] ];
420 $self->{inverted_shuffle} = [ invert(@{ $self->{shuffle} }) ]; 420 $self->{inverted_shuffle} = [ invert(@{ $self->{shuffle} }) ];
421} 421}
422 422
426 my @more_extras = complement([0..scalar(@{ $self->{answers} })-1], [@{ $self->{slice} }]); 426 my @more_extras = complement([0..scalar(@{ $self->{answers} })-1], [@{ $self->{slice} }]);
427 push( @{ $self->{extras} }, @{ $self->{answers} }[@more_extras] ); 427 push( @{ $self->{extras} }, @{ $self->{answers} }[@more_extras] );
428} 428}
429 429
430#Allows answers to be added to the end of the selected answers 430#Allows answers to be added to the end of the selected answers
431#This can be used to force answers like "None of the above" and/or "All of the above" to still occur at the 431#This can be used to force answers like "None of the above" and/or "All of the above" to still occur at the
432#end of the list instead of being randomized like the rest of the answers 432#end of the list instead of being randomized like the rest of the answers
433sub makeLast { 433sub makeLast {
434 my $self = shift; 434 my $self = shift;
435 my @input = @_; 435 my @input = @_;
436 436
437 push(@{ $self->{selected_a} }, @input); 437 push(@{ $self->{selected_a} }, @input);
438 $self->condense(); #make sure that the user has not accidentally forced a duplicate answer 438 $self->condense(); #make sure that the user has not accidentally forced a duplicate answer
439 #note: condense was changed to eliminate the first occurence of a duplicate 439 #note: condense was changed to eliminate the first occurence of a duplicate
440 #instead of the last occurence so that it could be used in this case and 440 #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 441 #would not negate the fact that one of the answers needs to be at the end
442} 442}
443 443
444#Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer 444#Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer
445#point to one and only one copy of that answer 445#point to one and only one copy of that answer
446sub old_condense { 446sub old_condense {
447 my $self = shift; 447 my $self = shift;
448 for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) { 448 for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) {
449 for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) { 449 for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) {
450 if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) { 450 if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) {
451 #then delete the duplicate answer at subscript $outer 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} }] ); 452 @{ $self->{selected_a} } = ( @{ $self->{selected_a} }[0..$outer-1], @{ $self->{selected_a} }[$outer+1..$#{ $self->{selected_a} }] );
453 453
454 #the values of inverted_shuffle point to the position elements in selected_a 454 #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 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 456 #greater than $outer must have its position be decremented by one
457 $inner--; #$inner must be greater than outer so decrement $inner first 457 $inner--; #$inner must be greater than outer so decrement $inner first
458 for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) { 458 for (my $pos = 0; $pos < @{ $self->{inverted_shuffle} }; $pos++) {
460 @{ $self->{inverted_shuffle} }[$pos] = $inner; 460 @{ $self->{inverted_shuffle} }[$pos] = $inner;
461 } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) { 461 } elsif ( @{ $self->{inverted_shuffle} }[$pos] > $outer ) {
462 @{ $self->{inverted_shuffle} }[$pos]--; 462 @{ $self->{inverted_shuffle} }[$pos]--;
463 } 463 }
464 } 464 }
465 #we just changed a bunch of pointers so we need to go back over the same answers again 465 #we just changed a bunch of pointers so we need to go back over the same answers again
466 #(so we decrement $inner (which we already did) and $outer to counter-act the for loop)) 466 #(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 467 #this could probably be done slightly less hackish with while loops instead of for loops
468 #$outer--; 468 #$outer--;
469 } 469 }
470 } 470 }
507 #because we just changed the element that $outer points to 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 508 #we need to run throught the loop to make sure that the new value at $outer has
509 #no duplicates as well 509 #no duplicates as well
510 #This means that we don't want to increment either counter (and we need to reset $inner) 510 #This means that we don't want to increment either counter (and we need to reset $inner)
511 $repeat = 1; 511 $repeat = 1;
512 $inner = $outer + 1; 512 $inner = $outer + 1;
513 } 513 }
514 $inner++ unless $repeat; 514 $inner++ unless $repeat;
515 } 515 }
516 $outer++ unless $repeat; 516 $outer++ unless $repeat;
517 } 517 }
522# so if the new value at $outer also had a duplicate then it was just skipped. 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 523# This shouldn't work but i'll leave it in for a while just in case
524 524
525##Eliminates duplicates answers and rearranges inverted_shuffle so that all questions with the same answer 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 526##point to one and only one copy of that answer
527#sub old_condense { 527#sub old_condense {
528# my $self = shift; 528# my $self = shift;
529# for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) { 529# for (my $outer = 0; $outer < @{ $self->{selected_a} }; $outer++) {
530# for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) { 530# for (my $inner = $outer+1; $inner < @{ $self->{selected_a} }; $inner++) {
531# if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) { 531# if (@{ $self->{selected_a} }[$outer] eq @{ $self->{selected_a} }[$inner]) {
532# #then delete the duplicate answer at subscript $outer 532# #then delete the duplicate answer at subscript $outer
563 my @array = @$r_input; 563 my @array = @$r_input;
564 $out .= "( " ; 564 $out .= "( " ;
565 while (@array) { 565 while (@array) {
566 $out .= pretty_print(shift @array) . " , "; 566 $out .= pretty_print(shift @array) . " , ";
567 } 567 }
568 $out .= " )"; 568 $out .= " )";
569 } elsif (ref($r_input) eq 'CODE') { 569 } elsif (ref($r_input) eq 'CODE') {
570 $out = "$r_input"; 570 $out = "$r_input";
571# } elsif (ref($r_input) =~/list/i or ref($r_input) =~/match/i or ref($r_input) =~/multiple/i) { 571# } elsif (ref($r_input) =~/list/i or ref($r_input) =~/match/i or ref($r_input) =~/multiple/i) {
572# local($^W) = 0; 572# local($^W) = 0;
573# $out .= ref($r_input) . " <BR>" ."<TABLE BGCOLOR = \"#FFFFFF\">"; 573# $out .= ref($r_input) . " <BR>" ."<TABLE BGCOLOR = \"#FFFFFF\">";

Legend:
Removed from v.1050  
changed lines
  Added in v.1079

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9