|
|
1 | #!/usr/local/bin/webwork-perl |
|
|
2 | |
|
|
3 | ########### |
|
|
4 | #use Carp; |
|
|
5 | |
|
|
6 | =head1 NAME |
|
|
7 | |
|
|
8 | Matrix macros for the PG language |
|
|
9 | |
|
|
10 | =head1 SYNPOSIS |
|
|
11 | |
|
|
12 | |
|
|
13 | |
|
|
14 | =head1 DESCRIPTION |
|
|
15 | |
|
|
16 | Almost all of the macros in the file are very rough at best. The most useful is display_matrix. |
|
|
17 | Many of the other macros work with vectors and matrices stored as anonymous arrays. |
|
|
18 | |
|
|
19 | Frequently it may be |
|
|
20 | more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there. |
|
|
21 | |
|
|
22 | |
|
|
23 | =cut |
|
|
24 | |
|
|
25 | BEGIN { |
|
|
26 | be_strict(); |
|
|
27 | } |
|
|
28 | |
|
|
29 | sub _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 | |
| 1 | sub zero_check{ |
36 | sub 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 | } |
| 16 | sub vec_dot{ |
51 | sub 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 | |
| 38 | sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector |
73 | sub 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. |
| 155 | sub apl_matrix_mult{ |
193 | sub 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 | |
| 179 | sub matrix_mult { |
218 | sub matrix_mult { |
| 180 | apl_matrix_mult($_[0], $_[1]); |
219 | apl_matrix_mult($_[0], $_[1]); |
| 181 | } |
220 | } |
|
|
221 | |
| 182 | sub make_matrix{ |
222 | sub 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 | } |
Parent Directory
| 
Revision Log
| 
Patch