Parent Directory
| 
Revision Log
Revision 64 - (view) (download) (as text)
| 1 : | gage | 45 | 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 : | maria | 64 | Usage \[ \{ display_matrix($A) \} \] |
| 79 : | gage | 45 | \[ \{ 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 : | maria | 64 | Usage: ra_flatten_matrix($A) |
| 132 : | gage | 45 | |
| 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 |