Parent Directory
| 
Revision Log
Added PGcomplexmacros.pl and PGmatrixmacros.pl to CVS
1 sub zero_check{ 2 my $array = shift; 3 my %options = @_; 4 my $num = @$array; 5 my $i; 6 my $max = 0; my $mm; 7 for ($i=0; $i< $num; $i++) { 8 $mm = $array->[$i] ; 9 $max = abs($mm) if abs($mm) > $max; 10 } 11 my $tol = $options{tol}; 12 $tol = 0.01*$options{reltol}*$average if defined($options{reltol}); 13 $tol = .000001 unless defined($tol); 14 ($max <$tol) ? 1: 0; # 1 if the array is close to constant; 15 } 16 sub vec_dot{ 17 my $vec1 = shift; 18 my $vec2 = shift; 19 warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. 20 my @vec1=@$vec1; 21 my @vec2=@$vec2; 22 my $sum = 0; 23 24 while(@vec1) { 25 $sum += shift(@vec1)*shift(@vec2); 26 } 27 $sum; 28 } 29 sub proj_vec { 30 my $vec = shift; 31 warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; 32 my $matrix = shift; # the matrix represents a set of vectors spanning the linear space 33 # onto which we want to project the vector. 34 warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0]; 35 $matrix * transpose($matrix) * $vec; 36 } 37 38 sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector 39 my $correct_vector = shift; 40 my %options = @_; 41 $ans_eval = sub { 42 my $in = shift @_; 43 44 $ans_hash = new AnswerHash; 45 my @in = split("\0",$in); 46 my @correct_vector=@$correct_vector; 47 $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; 48 $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; 49 50 return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension 51 52 my $correct_length = vec_dot($correct_vector,$correct_vector); 53 my $in_length = vec_dot(\@in,\@in); 54 return($ans_hash) if $in_length == 0; 55 56 if (defined($correct_length) and $correct_length != 0) { 57 my $constant = vec_dot($correct_vector,\@in)/$correct_length; 58 my @difference = (); 59 for(my $i=0; $i < @correct_vector; $i++ ) { 60 $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; 61 } 62 $ans_hash->{score} = zero_check(\@difference); 63 64 } else { 65 $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; 66 } 67 $ans_hash; 68 69 }; 70 71 $ans_eval; 72 } 73 74 ############ 75 76 =head4 display_matrix 77 78 Useage \[ \{ display_matrix($A) \} \] 79 \[ \{ display_matrix([ [ 1, 3], [4, 6] ]) \} \] 80 81 Output is text which represents the matrix in TeX format used in math display mode. 82 83 84 =cut 85 86 87 sub display_matrix{ # will display a matrix in tex format. 88 # the matrix can be either of type array or type 'Matrix' 89 my $ra_matrix = shift; 90 my $out=''; 91 if (ref($ra_matrix) eq 'Matrix' ) { 92 my ($rows, $cols) = $ra_matrix->dim(); 93 $out = q!\\left(\\begin{array}{! . 'c'x$cols . q!}!; 94 for( $i=1; $i<=$rows; $i++) { 95 for ($j=1; $j<=$cols; $j++) { 96 my $entry = $ra_matrix->element($i,$j); 97 $entry = "#" unless defined($entry); 98 $out.= $entry; 99 $out .= ($j < $cols) ? ' & ' : "\\cr\n"; 100 } 101 } 102 $out .= "\\end{array}\\right)"; 103 } elsif( ref($ra_matrix) eq 'ARRAY') { 104 my $rows = @$ra_matrix; 105 my $cols = @{$ra_matrix->[0]}; 106 $out = q!\\left(\\begin{array}{! . 'c' x$cols . q!}!; 107 for( $i=0; $i<$rows; $i++) { 108 my @row = @{$ra_matrix->[$i]}; 109 while (@row) { 110 my $entry = shift(@row); 111 $entry = "#" unless defined($entry); 112 $out.= $entry; 113 if (@row) { 114 $out .= "& "; 115 } else { 116 next; 117 } 118 } 119 $out .= "\\cr\n"; 120 } 121 $out .= "\\end{array}\\right)"; 122 } else { 123 warn "The input" . ref($ra_matrix) . " doesn't make sense as input to display_matrix. "; 124 } 125 $out; 126 } 127 128 129 =head4 ra_flatten_matrix 130 131 Useage: ra_flatten_matrix($A) 132 133 where $A is a matrix object 134 The output is a reference to an array. The matrix is placed in the array by iterating 135 over columns on the inside 136 loop, then over the rows. (e.g right to left and then down, as one reads text) 137 138 139 =cut 140 141 142 sub ra_flatten_matrix{ 143 my $matrix = shift; 144 warn "The argument must be a matrix object" unless ref($matrix) =~ /Matrix/; 145 my @array = (); 146 my ($rows, $cols ) = $matrix->dim(); 147 foreach my $i (1..$rows) { 148 foreach my $j (1..$cols) { 149 push(@array, $matrix->element($i,$j) ); 150 } 151 } 152 \@array; 153 } 154 155 sub apl_matrix_mult{ 156 $ra_a= shift; 157 $ra_b= shift; 158 %options = @_; 159 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; }; 161 $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'; 163 my $rows = @$ra_a; 164 my $cols = @{$ra_b->[0]}; 165 my $k_size = @$ra_b; 166 my $out ; 167 my ($i, $j, $k); 168 for($i=0;$i<$rows;$i++) { 169 for($j=0;$j<$cols;$j++) { 170 my @r = (); 171 for($k=0;$k<$k_size;$k++) { 172 $r[$k] = &$rf_op_times($ra_a->[$i]->[$k] , $ra_b->[$k]->[$j]); 173 } 174 $out->[$i]->[$j] = &$rf_op_plus( @r ); 175 } 176 } 177 $out; 178 } 179 sub matrix_mult { 180 apl_matrix_mult($_[0], $_[1]); 181 } 182 sub make_matrix{ 183 my $function = shift; 184 my $rows = shift; 185 my $cols = shift; 186 my ($i, $j, $k); 187 for($i=0;$i<$rows;$i++) { 188 for($j=0;$j<$cols;$j++) { 189 $ra_out->[$i]->[$j] = &$function($i,$j); 190 } 191 } 192 $ra_out; 193 } 194 195 196 # sub format_answer{ 197 # my $ra_eigenvalues = shift; 198 # my $ra_eigenvectors = shift; 199 # my $functionName = shift; 200 # my @eigenvalues=@$ra_eigenvalues; 201 # my $size= @eigenvalues; 202 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 203 # my $out = qq! 204 # $functionName(t) =! . 205 # displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen, 206 # 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''}, 207 # 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } 208 # ) ) ; 209 # $out; 210 # } 211 # sub format_vector_answer{ 212 # my $ra_eigenvalues = shift; 213 # my $ra_eigenvectors = shift; 214 # my $functionName = shift; 215 # my @eigenvalues=@$ra_eigenvalues; 216 # my $size= @eigenvalues; 217 # my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); 218 # my $out = qq! 219 # $functionName(t) =! . 220 # displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ; 221 # $out; 222 # } 223 # sub format_question{ 224 # my $ra_matrix = shift; 225 # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! 226 # 227 # } 228 229 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |