[system] / trunk / webwork / system / courseScripts / PGmatrixmacros.pl Repository: Repository Listing bbplugincoursesdistsnplrochestersystemwww

# Diff of /trunk/webwork/system/courseScripts/PGmatrixmacros.pl

Revision 218 Revision 219
1#!/usr/local/bin/webwork-perl
2
3###########
4#use Carp;
5
7
8 Matrix macros for the PG language
9
11
12
13
15
16Almost all of the macros in the file are very rough at best. The most useful is display_matrix.
17Many of the other macros work with vectors and matrices stored as anonymous arrays.
18
19Frequently it may be
20more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there.
21
22
23=cut
24
25BEGIN {
26 be_strict();
27}
28
29sub _PGmatrixmacros_init {
30}
31
32# this subroutine zero_check is not very well designed below -- if it is used much it should receive
33# more work -- particularly for checking relative tolerance. More work needs to be done if this is
34# actually used.
35
1sub zero_check{ 36sub zero_check{
2 my $array = shift; 37 my$array = shift;
3 my %options = @_; 38 my %options = @_;
4 my $num = @$array; 39 my $num = @$array;
5 my $i; 40 my$i;
7 for ($i=0;$i< $num;$i++) { 42 for ($i=0;$i< $num;$i++) {
8 $mm =$array->[$i] ; 43$mm = $array->[$i] ;
9 $max = abs($mm) if abs($mm) >$max; 44 $max = abs($mm) if abs($mm) >$max;
10 } 45 }
11 my $tol =$options{tol}; 46 my $tol =$options{tol};
12 $tol = 0.01*$options{reltol}*$average if defined($options{reltol}); 47 $tol = 0.01*$options{reltol}*$options{avg} if defined($options{reltol}) and defined $options{avg}; 13$tol = .000001 unless defined($tol); 48$tol = .000001 unless defined($tol); 14 ($max <$tol) ? 1: 0; # 1 if the array is close to constant; 49 ($max <$tol) ? 1: 0; # 1 if the array is close to zero; 15} 50} 16sub vec_dot{ 51sub vec_dot{ 17 my$vec1 = shift; 52 my $vec1 = shift; 18 my$vec2 = shift; 53 my $vec2 = shift; 19 warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. 54 warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. 36} 71} 37 72 38sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector 73sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector 39 my$correct_vector = shift; 74 my $correct_vector = shift; 40 my %options = @_; 75 my %options = @_; 41$ans_eval = sub { 76 my $ans_eval = sub { 42 my$in = shift @_; 77 my $in = shift @_; 43 78 44$ans_hash = new AnswerHash; 79 my $ans_hash = new AnswerHash; 45 my @in = split("\0",$in); 80 my @in = split("\0",$in); 46 my @correct_vector=@$correct_vector; 81 my @correct_vector=@$correct_vector; 47$ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 82 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 48$ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; 83 $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; 49 84 89 my$ra_matrix = shift; 124 my $ra_matrix = shift; 90 my$out=''; 125 my $out=''; 91 if (ref($ra_matrix) eq 'Matrix' ) { 126 if (ref($ra_matrix) eq 'Matrix' ) { 92 my ($rows, $cols) =$ra_matrix->dim(); 127 my ($rows,$cols) = $ra_matrix->dim(); 93$out = q!\\left(\\begin{array}{! . 'c'x$cols . q!}!; 128$out = q!\\left(\\begin{array}{! . 'c'x$cols . q!}!; 94 for($i=1; $i<=$rows; $i++) { 129 for( my$i=1; $i<=$rows; $i++) { 95 for ($j=1; $j<=$cols; $j++) { 130 for (my$j=1; $j<=$cols; $j++) { 96 my$entry = $ra_matrix->element($i,$j); 131 my$entry = $ra_matrix->element($i,$j); 97$entry = "#" unless defined($entry); 132$entry = "#" unless defined($entry); 98$out.= $entry; 133$out.= $entry; 99$out .= ($j <$cols) ? ' & ' : "\\cr\n"; 134 $out .= ($j < $cols) ? ' & ' : "\\cr\n"; 100 } 135 } 102$out .= "\\end{array}\\right)"; 137 $out .= "\\end{array}\\right)"; 103 } elsif( ref($ra_matrix) eq 'ARRAY') { 138 } elsif( ref($ra_matrix) eq 'ARRAY') { 104 my$rows = @$ra_matrix; 139 my$rows = @$ra_matrix; 105 my$cols = @{$ra_matrix->[0]}; 140 my$cols = @{$ra_matrix->[0]}; 106$out = q!\\left(\\begin{array}{! . 'c' x$cols . q!}!; 141$out = q!\\left(\\begin{array}{! . 'c' x$cols . q!}!; 107 for($i=0; $i<$rows; $i++) { 142 for(my$i=0; $i<$rows; $i++) { 108 my @row = @{$ra_matrix->[$i]}; 143 my @row = @{$ra_matrix->[$i]}; 109 while (@row) { 144 while (@row) { 110 my$entry = shift(@row); 145 my $entry = shift(@row); 111$entry = "#" unless defined($entry); 146$entry = "#" unless defined($entry); 112$out.= $entry; 147$out.= $entry; 150 } 185 } 151 } 186 } 152 \@array; 187 \@array; 153} 188} 154 189 190# This subroutine is probably obsolete and not generally useful. It was patterned after the APL 191# constructs for multiplying matrices. It might come in handy for non-standard multiplication of 192# of matrices (e.g. mod 2) for indice matrices. 155sub apl_matrix_mult{ 193sub apl_matrix_mult{ 156$ra_a= shift; 194 my $ra_a= shift; 157$ra_b= shift; 195 my $ra_b= shift; 158 %options = @_; 196 my %options = @_; 159 my$rf_op_times= sub {$_[0] *$_[1]}; 197 my $rf_op_times= sub {$_[0] *$_[1]}; 160 my$rf_op_plus = sub {my $sum = 0; my @in = @_; while(@in){$sum = $sum + shift(@in) }$sum; }; 198 my $rf_op_plus = sub {my$sum = 0; my @in = @_; while(@in){ $sum =$sum + shift(@in) } $sum; }; 161$rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE'; 199$rf_op_times = $options{'times'} if defined($options{'times'}) and ref($options{'times'}) eq 'CODE'; 162$rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE'; 200$rf_op_plus = $options{'plus'} if defined($options{'plus'}) and ref($options{'plus'}) eq 'CODE'; 163 my$rows = @$ra_a; 201 my$rows = @$ra_a; 174$out->[$i]->[$j] = &$rf_op_plus( @r ); 212$out->[$i]->[$j] = &$rf_op_plus( @r ); 175 } 213 } 176 } 214 } 177$out; 215 $out; 178} 216} 217 179sub matrix_mult { 218sub matrix_mult { 180 apl_matrix_mult($_[0], $_[1]); 219 apl_matrix_mult($_[0], $_[1]); 181} 220} 221 182sub make_matrix{ 222sub make_matrix{ 183 my$function = shift; 223 my $function = shift; 184 my$rows = shift; 224 my $rows = shift; 185 my$cols = shift; 225 my $cols = shift; 186 my ($i, $j,$k); 226 my ($i,$j, $k); 227 my$ra_out;
187 for($i=0;$i<$rows;$i++) { 228 for($i=0;$i<$rows;$i++) {
188 for($j=0;$j<$cols;$j++) { 229 for($j=0;$j<$cols;$j++) {
189 $ra_out->[$i]->[$j] = &$function($i,$j); 230 $ra_out->[$i]->[$j] = &$function($i,$j);
190 } 231 }
191 } 232 }

Legend:
 Removed from v.218 changed lines Added in v.219

 aubreyja at gmail dot com ViewVC Help Powered by ViewVC 1.0.9