diff --git a/lib/Matrix.pm b/lib/Matrix.pm index 18c8093ff9..af6bc8073d 100644 --- a/lib/Matrix.pm +++ b/lib/Matrix.pm @@ -1,11 +1,17 @@ =head1 NAME -Matrix - Matrix of Reals +lib/Matrix - Matrix of Reals -Implements overrides for MatrixReal.pm for WeBWorK =head1 DESCRIPTION +Implements overrides for MatrixReal.pm for WeBWorK +In general it is better to use MathObjects Matrices (Value::Matrix) +in writing PG problem. The answer checking is much superior with better +error messages for syntax errors in student entries. Some of the +subroutines in this file are still used behind the scenes +by Value::Matrix to perform calculations, +such as decompose_LR(). =head1 SYNOPSIS @@ -68,8 +74,22 @@ sub _stringify { return($s); } +=head3 Accessor functions + + (these are deprecated for direct use. Use the covering Methods + provided by MathObject Matrices instead.) + + L($matrix) - return matrix L of the LR decomposition + R($matrix) - return matrix R of the LR decomposition + PL($matrix) return + PR($matrix + +Original matrix is P_L * L * R *P_R # obtain the Left Right matrices of the decomposition and the two pivot permutation matrices # the original is M = PL*L*R*PR + +=cut + sub L { my $matrix = shift; my $rows = $matrix->[1]; @@ -119,10 +139,14 @@ sub PR { # use this permuation on the right PL*L*R*PR =M } # obtain the Left Right matrices of the decomposition and the two pivot permutation matrices # the original is M = PL*L*R*PR -=head4 + + +=item rh_options Method $matrix->rh_options +Meant for internal use when dealing with MatrixReal1 + =cut sub rh_options { @@ -132,14 +156,18 @@ sub rh_options { $self->[$MatrixReal1::OPTION_ENTRY]; # provides a reference to the options hash MEG } -=head4 - Method $matrix->trace - +=item trace + + Method: $matrix->trace Returns: scalar which is the trace of the matrix. + +Used by MathObject Matrices for calculating the trace. +Deprecated for direct use in PG questions. =cut + sub trace { my $self = shift; my $rows = $self->[1]; @@ -152,9 +180,12 @@ sub trace { $sum; } -=head4 - Method $matrix->new_from_array_ref +=item new_from_array_ref + + Method $new_matrix = $matrix->new_from_array_ref ([[a,b,c],[d,e,f]]) + +Deprecated in favor of using creation tools for MathObject Matrices =cut @@ -168,10 +199,12 @@ sub new_from_array_ref { # this will build a matrix or a row vector from [a, b $matrix; } -=head4 +=item array_ref Method $matrix->array_ref +Converts Matrix from an ARRAY to an ARRAY reference. + =cut sub array_ref { @@ -179,10 +212,12 @@ sub array_ref { $this->[0]; } -=head4 +=item list Method $matrix->list +Converts a Matrix column vector to an ARRAY (list). + =cut sub list { # this is used only for column vectors @@ -196,29 +231,14 @@ sub list { # this is used only for column vectors @list; } -=head4 - - Method $matrix->new_from_list - -=cut - -sub new_from_list { # this builds a row vector from an array - my $class = shift; - my @list = @_; - my $cols = @list; - my $rows = 1; - my $matrix = new Matrix($rows, $cols); - my $i=1; - while(@list) { - my $elem = shift(@list); - $matrix->assign($i++,1, $elem); - } - $matrix; -} -=head4 +=item new_row_matrix Method $matrix->new_row_matrix + +Deprecated -- there are better tools for MathObject Matrices. + +Create a row 1 by n matrix from a list. This subroutine appears to be broken =cut @@ -236,10 +256,12 @@ sub new_row_matrix { # this builds a row vector from an array $matrix; } -=head4 +=item proj Method $matrix->proj - + Provides behind the scenes calculations for MathObject Matrix->proj + Deprecated for direct use in favor of methods of MathObject matrix + =cut sub proj{ @@ -248,9 +270,12 @@ sub proj{ $self * $self ->proj_coeff($vec); } -=head4 +=item proj_coeff Method $matrix->proj_coeff + +Provides behind the scenes calculations for MathObject Matrix->proj_coeff +Deprecated for direct use in favor of methods of MathObject matrix =cut @@ -267,10 +292,12 @@ sub proj_coeff{ $x_vector; } -=head4 +=item new_column_matrix Method $matrix->new_column_matrix +Create column matrix from an ARRAY reference (list reference) + =cut sub new_column_matrix { @@ -286,13 +313,15 @@ sub new_column_matrix { $matrix; } -=head4 - - This method takes an array of column vectors, or an array of arrays, - and converts them to a matrix where each column is one of the previous - vectors. +=item new_from_col_vecs Method $matrix->new_from_col_vecs + +Deprecated: The tools for creating MathObjects Matrices are simpler. +This method takes an array of column vectors, or an array of arrays, +and converts them to a matrix where each column is one of the previous +vectors. + =cut @@ -341,9 +370,11 @@ sub new_from_col_vecs =cut -=head4 +=item cp - Method $matrix->new_from_col_vecs + Function: cp() + +Provides ability to use perl complex numbers. N =cut @@ -354,7 +385,7 @@ sub cp { # MEG makes new copies of complex number return $w; } -=head4 +=item copy Method $matrix->copy @@ -397,7 +428,7 @@ sub copy # MEG added 6/25/03 to accomodate complex entries -=head4 +=item conj Method $matrix->conj @@ -409,7 +440,7 @@ sub conj { $elem; } -=head4 +=item transpose Method $matrix->transpose @@ -458,10 +489,13 @@ sub transpose $matrix1; } -=head4 +=item decompose_LR Method $matrix->decompose_LR +Used by MathObjects Matrix for LR decomposition +Deprecated for direct use in PG problems. + =cut sub decompose_LR diff --git a/lib/Value.pm b/lib/Value.pm index 8fdf9aefc5..a58148861e 100644 --- a/lib/Value.pm +++ b/lib/Value.pm @@ -691,7 +691,7 @@ sub class { # # Get an element from a point, vector, matrix, or list -# +# An index (3,4) indicates row 3, column 4 -- NOT a slice of a one dimensional list sub extract { my $M = shift; my $i; my @indices = @_; return unless Value::isValue($M); diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index e853ff5ff5..1cbbdcd249 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -3,6 +3,111 @@ # Implements the Matrix class. # # @@@ Still needs lots of work @@@ + +=head1 NAME + + Value::Matrix class + + +References: + +MathObject Matrix methods: L +MathObject Contexts: L +CPAN RealMatrix docs: L + +Allowing Matrices in Fractions: +L + + Context()->parens->set("[" => {formMatrix => 1}); + +Files interacting with Matrices: + +L L +L + +L -- checking whether vectors form a basis +L -- tools for row reduction via elementary matrices +L -- Generates unimodular matrices with real entries +L +L +L +L +L +L +Contexts + + Matrix -- allows students to enter [[3,4],[3,6]] + -- formMatrix =>1 also allows this? + Complex-Matrix -- allows complex entries + +Creation methods + + $M1 = Matrix([1,2],[3,4]); + $M2 = Matrix([5,6],[7,8]); + $v = Vector(9,10); + $w = ColumnVector(9,10); # differs in how it is printed + +Commands added in Value::matrix + + Conversion + $matrix->values produces [[3,4,5],[1,3,4]] recursive array references of numbers (not MathObjects) + $matrix->wwMatrix produces CPAN MatrixReal1 matrix, used for computation subroutines + + Information + $matrix->dimension: ARRAY + + Access values + + row : MathObjectMatrix + column : MathObjectMatrix + element : Real or Complex value + + Assign values + + these need to be added: + +see C in MatrixReduce and L + + Advanced + $matrix->data: ARRAY reference (internal data) of MathObjects (Real,Complex, Fractions) + stored at each location. + + +Passthrough methods covering subroutines in Matrix.pm which overrides or +augment CPAN's MatrixReal1.pm. Matrix is a specialized subclass of MatrixReal1.pm + +The actual calculations are done in Matrix.pm + + trace + proj + proj_coeff + L + R + PL + PR + +Passthrough methods covering subroutines in MatrixReal1.pm +(this has been modified to handle complex numbers) +The actual calculations are done in MatrixReal1.pm subroutines + + condition + det + inverse + is_symmetric + decompose_LR + dim + norm_one + norm_max + kleene + normalize + solve_LR (also solve()) + order_LR (also order() + solve_GSM + solve_SSM + solve_RM + +=cut + # package Value::Matrix; my $pkg = 'Value::Matrix'; @@ -17,7 +122,7 @@ our @ISA = qw(Value); # a point, vector or matrix object, a matrix-valued formula, or a string # that evaluates to a matrix # -sub new { +sub new { #internal my $self = shift; my $class = ref($self) || $self; my $context = (Value::isContext($_[0]) ? shift : $self->context); my $M = shift; $M = [] unless defined $M; $M = [$M,@_] if scalar(@_) > 0; @@ -38,7 +143,7 @@ sub new { # (Recursively) make a matrix from a list of array refs # and report errors about the entry types # -sub matrixMatrix { +sub matrixMatrix { #internal my $self = shift; my $class = ref($self) || $self; my $context = shift; my ($x,$m); my @M = (); my $isFormula = 0; @@ -62,7 +167,7 @@ sub matrixMatrix { # Form a 1 x n matrix from a list of numbers # (could become a row of an m x n matrix) # -sub numberMatrix { +sub numberMatrix { #internal my $self = shift; my $class = ref($self) || $self; my $context = shift; my @M = (); my $isFormula = 0; @@ -209,7 +314,7 @@ sub mult { # # Constant multiplication # - if (Value::matchNumber($r) || Value::isComplex($r)) { + if (Value::isNumber($r)) { my @coords = (); foreach my $x (@{$l->data}) {push(@coords,$x*$r)} return $self->make(@coords); @@ -247,8 +352,7 @@ sub mult { sub div { my ($l,$r,$flag) = @_; my $self = $l; Value::Error("Can't divide by a Matrix") if $flag; - Value::Error("Matrices can only be divided by Numbers") - unless (Value::matchNumber($r) || Value::isComplex($r)); + Value::Error("Matrices can only be divided by Numbers") unless Value::isNumber($r); Value::Error("Division by zero") if $r == 0; my @coords = (); foreach my $x (@{$l->data}) {push(@coords,$x/$r)} diff --git a/lib/Value/Point.pm b/lib/Value/Point.pm index 6ab10d25bf..9d508ef265 100644 --- a/lib/Value/Point.pm +++ b/lib/Value/Point.pm @@ -81,8 +81,7 @@ sub sub { sub mult { my ($l,$r) = @_; my $self = $l; - Value::Error("Points can only be multiplied by Numbers") - unless (Value::matchNumber($r) || Value::isComplex($r)); + Value::Error("Points can only be multiplied by Numbers") unless Value::isNumber($r); my @coords = (); foreach my $x ($l->value) {push(@coords,$x*$r)} return $self->make(@coords); @@ -91,8 +90,7 @@ sub mult { sub div { my ($l,$r,$flag) = @_; my $self = $l; Value::Error("Can't divide by a Point") if $flag; - Value::Error("Points can only be divided by Numbers") - unless (Value::matchNumber($r) || Value::isComplex($r)); + Value::Error("Points can only be divided by Numbers") unless Value::isNumber($r); Value::Error("Division by zero") if $r == 0; my @coords = (); foreach my $x ($l->value) {push(@coords,$x/$r)} diff --git a/lib/Value/Vector.pm b/lib/Value/Vector.pm index 16116a2dab..52ac31f79f 100644 --- a/lib/Value/Vector.pm +++ b/lib/Value/Vector.pm @@ -92,8 +92,7 @@ sub sub { sub mult { my ($l,$r,$flag) = @_; my $self = $l; - Value::Error("Vectors can only be multiplied by Numbers") - unless (Value::matchNumber($r) || Value::isComplex($r)); + Value::Error("Vectors can only be multiplied by Numbers") unless Value::isNumber($r); my @coords = (); foreach my $x ($l->value) {push(@coords,$x*$r)} return $self->make(@coords); @@ -102,8 +101,7 @@ sub mult { sub div { my ($l,$r,$flag) = @_; my $self = $l; Value::Error("Can't divide by a Vector") if $flag; - Value::Error("Vectors can only be divided by Numbers") - unless (Value::matchNumber($r) || Value::isComplex($r)); + Value::Error("Vectors can only be divided by Numbers") unless Value::isNumber($r); Value::Error("Division by zero") if $r == 0; my @coords = (); foreach my $x ($l->value) {push(@coords,$x/$r)} diff --git a/lib/WWAccessor.pm b/lib/WWAccessor.pm new file mode 100644 index 0000000000..62051d4626 --- /dev/null +++ b/lib/WWAccessor.pm @@ -0,0 +1,745 @@ +package WWAccessor; +require 5.00502; +#use strict; +$WWAccessor::VERSION = '0.34'; +# Hacked version of Class::Accessor that will run? with WeBWorK. + +sub new { + my($proto, $fields) = @_; + my($class) = ref $proto || $proto; + + $fields = {} unless defined $fields; + + # make a copy of $fields. + bless {%$fields}, $class; +} + +sub mk_accessors { + my($self, @fields) = @_; + + $self->_mk_accessors('rw', @fields); +} + +if (eval { require Sub::Name }) { + Sub::Name->import; +} + +{ + no strict 'refs'; + + sub import { + my ($class, @what) = @_; + my $caller = caller; + for (@what) { + if (/^(?:antlers|moose-?like)$/i) { + *{"${caller}::has"} = sub { + my ($f, %args) = @_; + $caller->_mk_accessors(($args{is}||"rw"), $f); + }; + *{"${caller}::extends"} = sub { + @{"${caller}::ISA"} = @_; + unless (grep $_->can("_mk_accessors"), @_) { + push @{"${caller}::ISA"}, $class; + } + }; + # we'll use their @ISA as a default, in case it happens to be + # set already + &{"${caller}::extends"}(@{"${caller}::ISA"}); + } + } + } + + sub follow_best_practice { + my($self) = @_; + my $class = ref $self || $self; + *{"${class}::accessor_name_for"} = \&best_practice_accessor_name_for; + *{"${class}::mutator_name_for"} = \&best_practice_mutator_name_for; + } + + sub _mk_accessors { + my($self, $access, @fields) = @_; + my $class = ref $self || $self; + my $ra = $access eq 'rw' || $access eq 'ro'; + my $wa = $access eq 'rw' || $access eq 'wo'; + + foreach my $field (@fields) { + my $accessor_name = $self->accessor_name_for($field); + my $mutator_name = $self->mutator_name_for($field); + if( $accessor_name eq 'DESTROY' or $mutator_name eq 'DESTROY' ) { + $self->_carp("Having a data accessor named DESTROY in '$class' is unwise."); + } + if ($accessor_name eq $mutator_name) { + my $accessor; + if ($ra && $wa) { + $accessor = $self->make_accessor($field); + } elsif ($ra) { + $accessor = $self->make_ro_accessor($field); + } else { + $accessor = $self->make_wo_accessor($field); + } + my $fullname = "${class}::$accessor_name"; + my $subnamed = 0; + unless (defined &{$fullname}) { + subname($fullname, $accessor) if defined &subname; + $subnamed = 1; + *{$fullname} = $accessor; + } + if ($accessor_name eq $field) { + # the old behaviour + my $alias = "${class}::_${field}_accessor"; + subname($alias, $accessor) if defined &subname and not $subnamed; + *{$alias} = $accessor unless defined &{$alias}; + } + } else { + my $fullaccname = "${class}::$accessor_name"; + my $fullmutname = "${class}::$mutator_name"; + if ($ra and not defined &{$fullaccname}) { + my $accessor = $self->make_ro_accessor($field); + subname($fullaccname, $accessor) if defined &subname; + *{$fullaccname} = $accessor; + } + if ($wa and not defined &{$fullmutname}) { + my $mutator = $self->make_wo_accessor($field); + subname($fullmutname, $mutator) if defined &subname; + *{$fullmutname} = $mutator; + } + } + } + } + +} + +sub mk_ro_accessors { + my($self, @fields) = @_; + + $self->_mk_accessors('ro', @fields); +} + +sub mk_wo_accessors { + my($self, @fields) = @_; + + $self->_mk_accessors('wo', @fields); +} + +sub best_practice_accessor_name_for { + my ($class, $field) = @_; + return "get_$field"; +} + +sub best_practice_mutator_name_for { + my ($class, $field) = @_; + return "set_$field"; +} + +sub accessor_name_for { + my ($class, $field) = @_; + return $field; +} + +sub mutator_name_for { + my ($class, $field) = @_; + return $field; +} + +sub set { + my($self, $key) = splice(@_, 0, 2); + + if(@_ == 1) { + $self->{$key} = $_[0]; + } + elsif(@_ > 1) { + $self->{$key} = [@_]; + } + else { + $self->_croak("Wrong number of arguments received"); + } +} + +sub get { + my $self = shift; + + if(@_ == 1) { + return $self->{$_[0]}; + } + elsif( @_ > 1 ) { + return @{$self}{@_}; + } + else { + $self->_croak("Wrong number of arguments received"); + } +} + +sub make_accessor { + my ($class, $field) = @_; + + return sub { + my $self = shift; + + if(@_) { + return $self->set($field, @_); + } else { + return $self->get($field); + } + }; +} + +sub make_ro_accessor { + my($class, $field) = @_; + + return sub { + my $self = shift; + + if (@_) { + my $caller = caller; + $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'"); + } + else { + return $self->get($field); + } + }; +} + +sub make_wo_accessor { + my($class, $field) = @_; + + return sub { + my $self = shift; + + unless (@_) { + my $caller = caller; + $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'"); + } + else { + return $self->set($field, @_); + } + }; +} + + +#use Carp (); + +sub _carp { + my ($self, $msg) = @_; + Carp::carp($msg || $self); + return; +} + +sub _croak { + my ($self, $msg) = @_; + Carp::croak($msg || $self); + return; +} + +1; + +__END__ + +=head1 NAME + + WWAccessor - Automated accessor generation + +=head1 SYNOPSIS + + package Foo; + use base qw(WWAccessor); + Foo->follow_best_practice; + Foo->mk_accessors(qw(name role salary)); + + # or if you prefer a Moose-like interface... + + package Foo; + use WWAccessor "antlers"; + has name => ( is => "rw", isa => "Str" ); + has role => ( is => "rw", isa => "Str" ); + has salary => ( is => "rw", isa => "Num" ); + + # Meanwhile, in a nearby piece of code! + # WWAccessor provides new(). + my $mp = Foo->new({ name => "Marty", role => "JAPH" }); + + my $job = $mp->role; # gets $mp->{role} + $mp->salary(400000); # sets $mp->{salary} = 400000 # I wish + + # like my @info = @{$mp}{qw(name role)} + my @info = $mp->get(qw(name role)); + + # $mp->{salary} = 400000 + $mp->set('salary', 400000); + + +=head1 DESCRIPTION + +This module automagically generates accessors/mutators for your class. + +Most of the time, writing accessors is an exercise in cutting and +pasting. You usually wind up with a series of methods like this: + + sub name { + my $self = shift; + if(@_) { + $self->{name} = $_[0]; + } + return $self->{name}; + } + + sub salary { + my $self = shift; + if(@_) { + $self->{salary} = $_[0]; + } + return $self->{salary}; + } + + # etc... + +One for each piece of data in your object. While some will be unique, +doing value checks and special storage tricks, most will simply be +exercises in repetition. Not only is it Bad Style to have a bunch of +repetitious code, but it's also simply not lazy, which is the real +tragedy. + +If you make your module a subclass of WWAccessor and declare your +accessor fields with mk_accessors() then you'll find yourself with a +set of automatically generated accessors which can even be +customized! + +The basic set up is very simple: + + package Foo; + use base qw(WWAccessor); + Foo->mk_accessors( qw(far bar car) ); + +Done. Foo now has simple far(), bar() and car() accessors +defined. + +Alternatively, if you want to follow Damian's I guidelines +you can use: + + package Foo; + use base qw(WWAccessor); + Foo->follow_best_practice; + Foo->mk_accessors( qw(far bar car) ); + +B you must call C before calling C. + +=head2 Moose-like + +By popular demand we now have a simple Moose-like interface. You can now do: + + package Foo; + use WWAccessor "antlers"; + has far => ( is => "rw" ); + has bar => ( is => "rw" ); + has car => ( is => "rw" ); + +Currently only the C attribute is supported. + +=head1 CONSTRUCTOR + +WWAccessor provides a basic constructor, C. It generates a +hash-based object and can be called as either a class method or an +object method. + +=head2 new + + my $obj = Foo->new; + my $obj = $other_obj->new; + + my $obj = Foo->new(\%fields); + my $obj = $other_obj->new(\%fields); + +It takes an optional %fields hash which is used to initialize the +object (handy if you use read-only accessors). The fields of the hash +correspond to the names of your accessors, so... + + package Foo; + use base qw(WWAccessor); + Foo->mk_accessors('foo'); + + my $obj = Foo->new({ foo => 42 }); + print $obj->foo; # 42 + +however %fields can contain anything, new() will shove them all into +your object. + +=head1 MAKING ACCESSORS + +=head2 follow_best_practice + +In Damian's Perl Best Practices book he recommends separate get and set methods +with the prefix set_ and get_ to make it explicit what you intend to do. If you +want to create those accessor methods instead of the default ones, call: + + __PACKAGE__->follow_best_practice + +B you call any of the accessor-making methods. + +=head2 accessor_name_for / mutator_name_for + +You may have your own crazy ideas for the names of the accessors, so you can +make those happen by overriding C and C in +your subclass. (I copied that idea from Class::DBI.) + +=head2 mk_accessors + + __PACKAGE__->mk_accessors(@fields); + +This creates accessor/mutator methods for each named field given in +@fields. Foreach field in @fields it will generate two accessors. +One called "field()" and the other called "_field_accessor()". For +example: + + # Generates foo(), _foo_accessor(), bar() and _bar_accessor(). + __PACKAGE__->mk_accessors(qw(foo bar)); + +See L +for details. + +=head2 mk_ro_accessors + + __PACKAGE__->mk_ro_accessors(@read_only_fields); + +Same as mk_accessors() except it will generate read-only accessors +(ie. true accessors). If you attempt to set a value with these +accessors it will throw an exception. It only uses get() and not +set(). + + package Foo; + use base qw(WWAccessor); + Foo->mk_ro_accessors(qw(foo bar)); + + # Let's assume we have an object $foo of class Foo... + print $foo->foo; # ok, prints whatever the value of $foo->{foo} is + $foo->foo(42); # BOOM! Naughty you. + + +=head2 mk_wo_accessors + + __PACKAGE__->mk_wo_accessors(@write_only_fields); + +Same as mk_accessors() except it will generate write-only accessors +(ie. mutators). If you attempt to read a value with these accessors +it will throw an exception. It only uses set() and not get(). + +B I'm not entirely sure why this is useful, but I'm sure someone +will need it. If you've found a use, let me know. Right now it's here +for orthoginality and because it's easy to implement. + + package Foo; + use base qw(WWAccessor); + Foo->mk_wo_accessors(qw(foo bar)); + + # Let's assume we have an object $foo of class Foo... + $foo->foo(42); # OK. Sets $self->{foo} = 42 + print $foo->foo; # BOOM! Can't read from this accessor. + +=head1 Moose! + +If you prefer a Moose-like interface to create accessors, you can use C by +importing this module like this: + + use WWAccessor "antlers"; + +or + + use WWAccessor "moose-like"; + +Then you can declare accessors like this: + + has alpha => ( is => "rw", isa => "Str" ); + has beta => ( is => "ro", isa => "Str" ); + has gamma => ( is => "wo", isa => "Str" ); + +Currently only the C attribute is supported. And our C also supports +the "wo" value to make a write-only accessor. + +If you are using the Moose-like interface then you should use the C +rather than tweaking your C<@ISA> directly. Basically, replace + + @ISA = qw/Foo Bar/; + +with + + extends(qw/Foo Bar/); + +=head1 DETAILS + +An accessor generated by WWAccessor looks something like +this: + + # Your foo may vary. + sub foo { + my($self) = shift; + if(@_) { # set + return $self->set('foo', @_); + } + else { + return $self->get('foo'); + } + } + +Very simple. All it does is determine if you're wanting to set a +value or get a value and calls the appropriate method. +WWAccessor provides default get() and set() methods which +your class can override. They're detailed later. + +=head2 Modifying the behavior of the accessor + +Rather than actually modifying the accessor itself, it is much more +sensible to simply override the two key methods which the accessor +calls. Namely set() and get(). + +If you -really- want to, you can override make_accessor(). + +=head2 set + + $obj->set($key, $value); + $obj->set($key, @values); + +set() defines how generally one stores data in the object. + +override this method to change how data is stored by your accessors. + +=head2 get + + $value = $obj->get($key); + @values = $obj->get(@keys); + +get() defines how data is retreived from your objects. + +override this method to change how it is retreived. + +=head2 make_accessor + + $accessor = __PACKAGE__->make_accessor($field); + +Generates a subroutine reference which acts as an accessor for the given +$field. It calls get() and set(). + +If you wish to change the behavior of your accessors, try overriding +get() and set() before you start mucking with make_accessor(). + +=head2 make_ro_accessor + + $read_only_accessor = __PACKAGE__->make_ro_accessor($field); + +Generates a subroutine refrence which acts as a read-only accessor for +the given $field. It only calls get(). + +Override get() to change the behavior of your accessors. + +=head2 make_wo_accessor + + $read_only_accessor = __PACKAGE__->make_wo_accessor($field); + +Generates a subroutine refrence which acts as a write-only accessor +(mutator) for the given $field. It only calls set(). + +Override set() to change the behavior of your accessors. + +=head1 EXCEPTIONS + +If something goes wrong WWAccessor will warn or die by calling Carp::carp +or Carp::croak. If you don't like this you can override _carp() and _croak() in +your subclass and do whatever else you want. + +=head1 EFFICIENCY + +WWAccessor does not employ an autoloader, thus it is much faster +than you'd think. Its generated methods incur no special penalty over +ones you'd write yourself. + + accessors: + Rate Basic Fast Faster Direct + Basic 367589/s -- -51% -55% -89% + Fast 747964/s 103% -- -9% -77% + Faster 819199/s 123% 10% -- -75% + Direct 3245887/s 783% 334% 296% -- + + mutators: + Rate Acc Fast Faster Direct + Acc 265564/s -- -54% -63% -91% + Fast 573439/s 116% -- -21% -80% + Faster 724710/s 173% 26% -- -75% + Direct 2860979/s 977% 399% 295% -- + +WWAccessor::Fast is faster than methods written by an average programmer +(where "average" is based on Schwern's example code). + +WWAccessor is slower than average, but more flexible. + +WWAccessor::Faster is even faster than WWAccessor::Fast. It uses an +array internally, not a hash. This could be a good or bad feature depending on +your point of view. + +Direct hash access is, of course, much faster than all of these, but it +provides no encapsulation. + +Of course, it's not as simple as saying "WWAccessor is slower than +average". These are benchmarks for a simple accessor. If your accessors do +any sort of complicated work (such as talking to a database or writing to a +file) the time spent doing that work will quickly swamp the time spend just +calling the accessor. In that case, WWAccessor and the ones you write +will be roughly the same speed. + + +=head1 EXAMPLES + +Here's an example of generating an accessor for every public field of +your class. + + package Altoids; + + use base qw(WWAccessor Class::Fields); + use fields qw(curiously strong mints); + Altoids->mk_accessors( Altoids->show_fields('Public') ); + + sub new { + my $proto = shift; + my $class = ref $proto || $proto; + return fields::new($class); + } + + my Altoids $tin = Altoids->new; + + $tin->curiously('Curiouser and curiouser'); + print $tin->{curiously}; # prints 'Curiouser and curiouser' + + + # Subclassing works, too. + package Mint::Snuff; + use base qw(Altoids); + + my Mint::Snuff $pouch = Mint::Snuff->new; + $pouch->strong('Blow your head off!'); + print $pouch->{strong}; # prints 'Blow your head off!' + + +Here's a simple example of altering the behavior of your accessors. + + package Foo; + use base qw(WWAccessor); + Foo->mk_accessors(qw(this that up down)); + + sub get { + my $self = shift; + + # Note every time someone gets some data. + print STDERR "Getting @_\n"; + + $self->SUPER::get(@_); + } + + sub set { + my ($self, $key) = splice(@_, 0, 2); + + # Note every time someone sets some data. + print STDERR "Setting $key to @_\n"; + + $self->SUPER::set($key, @_); + } + + +=head1 CAVEATS AND TRICKS + +WWAccessor has to do some internal wackiness to get its +job done quickly and efficiently. Because of this, there's a few +tricks and traps one must know about. + +Hey, nothing's perfect. + +=head2 Don't make a field called DESTROY + +This is bad. Since DESTROY is a magical method it would be bad for us +to define an accessor using that name. WWAccessor will +carp if you try to use it with a field named "DESTROY". + +=head2 Overriding autogenerated accessors + +You may want to override the autogenerated accessor with your own, yet +have your custom accessor call the default one. For instance, maybe +you want to have an accessor which checks its input. Normally, one +would expect this to work: + + package Foo; + use base qw(WWAccessor); + Foo->mk_accessors(qw(email this that whatever)); + + # Only accept addresses which look valid. + sub email { + my($self) = shift; + my($email) = @_; + + if( @_ ) { # Setting + require Email::Valid; + unless( Email::Valid->address($email) ) { + carp("$email doesn't look like a valid address."); + return; + } + } + + return $self->SUPER::email(@_); + } + +There's a subtle problem in the last example, and it's in this line: + + return $self->SUPER::email(@_); + +If we look at how Foo was defined, it called mk_accessors() which +stuck email() right into Foo's namespace. There *is* no +SUPER::email() to delegate to! Two ways around this... first is to +make a "pure" base class for Foo. This pure class will generate the +accessors and provide the necessary super class for Foo to use: + + package Pure::Organic::Foo; + use base qw(WWAccessor); + Pure::Organic::Foo->mk_accessors(qw(email this that whatever)); + + package Foo; + use base qw(Pure::Organic::Foo); + +And now Foo::email() can override the generated +Pure::Organic::Foo::email() and use it as SUPER::email(). + +This is probably the most obvious solution to everyone but me. +Instead, what first made sense to me was for mk_accessors() to define +an alias of email(), _email_accessor(). Using this solution, +Foo::email() would be written with: + + return $self->_email_accessor(@_); + +instead of the expected SUPER::email(). + + +=head1 AUTHORS + +Copyright 2009 Marty Pauley + +This program is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. That means either (a) the GNU General Public +License or (b) the Artistic License. + +=head2 ORIGINAL AUTHOR + +Michael G Schwern + +=head2 THANKS + +Liz and RUZ for performance tweaks. + +Tels, for his big feature request/bug report. + +Various presenters at YAPC::Asia 2009 for criticising the non-Moose interface. + +=head1 SEE ALSO + +See L and L if speed is more +important than flexibility. + +These are some modules which do similar things in different ways +L, L, L, +L, L, L, L + +See L for an example of this module in use. + +=cut diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index 8eb8c018c4..7801727a1d 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -261,7 +261,7 @@ sub path_is_course_subdir { sub query_sage_server { my ($python, $url, $accepted_tos, $setSeed, $webworkfunc, $debug, $curlCommand)=@_; # my $sagecall = qq{$curlCommand -i -k -sS -L --http1.1 --data-urlencode "accepted_tos=${accepted_tos}"}. - qq{ --data-urlencode 'user_expressions={"WEBWORK":"_webwork_safe_json(WEBWORK)"}' --data-urlencode "code=${setSeed}${webworkfunc}$python" $url}; +# qq{ --data-urlencode 'user_expressions={"WEBWORK":"_webwork_safe_json(WEBWORK)"}' --data-urlencode "code=${setSeed}${webworkfunc}$python" $url}; my $sagecall = qq{$curlCommand -i -k -sS -L --data-urlencode "accepted_tos=${accepted_tos}"}. qq{ --data-urlencode 'user_expressions={"WEBWORK":"_webwork_safe_json(WEBWORK)"}' --data-urlencode "code=${setSeed}${webworkfunc}$python" $url}; diff --git a/macros/MatrixCheckers.pl b/macros/MatrixCheckers.pl index 6f4c963173..ec13808365 100644 --- a/macros/MatrixCheckers.pl +++ b/macros/MatrixCheckers.pl @@ -87,23 +87,23 @@ =head1 DESCRIPTION are produced by C<\(\Bigg\lbrace\)> and C<\(\Bigg\rbrace\)>, are a matter of personal preference (since a basis is an ordered set, I like to include braces). -=over 12 -Context()->texStrings; -BEGIN_TEXT -Find an orthonormal basis for... -$BR -$BR -$BCENTER -\(\Bigg\lbrace\) -\{ $multians->ans_array(15) \}, -\{ $multians->ans_array(15) \} -\(\Bigg\rbrace.\) -$ECENTER -END_TEXT -Context()->normalStrings; -=back + Context()->texStrings; + BEGIN_TEXT + Find an orthonormal basis for... + $BR + $BR + $BCENTER + \(\Bigg\lbrace\) + \{ $multians->ans_array(15) \}, + \{ $multians->ans_array(15) \} + \(\Bigg\rbrace.\) + $ECENTER + END_TEXT + Context()->normalStrings; + + The answer evaluation section of the PG file is totally standard. diff --git a/macros/MatrixReduce.pl b/macros/MatrixReduce.pl index 010d732269..a77925dc76 100644 --- a/macros/MatrixReduce.pl +++ b/macros/MatrixReduce.pl @@ -14,27 +14,45 @@ =head1 SYNOPSIS =over 12 -=item Get the reduced row echelon form: C<$Areduced = rref($A);> Should be used in the fraction context with all entries of $A made into fractions. +=item Get the reduced row echelon form: C<$Areduced = rref($A);> + +Should be used in the fraction context with all entries of $A made into fractions. -=item Make matrix entries do fraction arithmetic (rather than decimal arithmetic): After selecting the Fraction context using Context('Fraction')->parens->set("[" => {formMatrix => 1}), C<$A = apply_fraction_to_matrix_entries($A);> applies Fraction() to all of the entries of $A, which makes subsequent matrix algebra computations with $A use fraction arithmetic. +=item Make matrix entries do fraction arithmetic (rather than decimal arithmetic): + +After selecting the Fraction context using Context('Fraction')->parens->set("[" => {formMatrix => 1}), C<$A = apply_fraction_to_matrix_entries($A);> applies Fraction() to all of the entries of $A, which makes subsequent matrix algebra computations with $A use fraction arithmetic. =item Get the reduced column echelon form: C<$Areduced = rcef($A);> -=item Change the value of a matrix entry: C changes the [2,3] entry to the value 50. +=item Change the value of a matrix entry: C + +changes the [2,3] entry to the value 50. =item Construct an n x n identity matrix: C<$E = identity_matrix(5);> -=item Construct an n x n elementary matrix that will permute rows i and j: C<$E = elem_matrix_row_switch(5,2,4);> creates a 5 x 5 identity matrix and swaps rows 2 and 4. +=item Construct an n x n elementary matrix that will permute rows i and j: + +C<$E = elem_matrix_row_switch(5,2,4);> creates a 5 x 5 identity matrix and swaps rows 2 and 4. + +=item Construct an n x n elementary matrix that will multiply row i by s: C<$E = elem_matrix_row_mult(5,2,4);> + +creates a 5 x 5 identity matrix and swaps puts 4 in the second spot on the diagonal. -=item Construct an n x n elementary matrix that will multiply row i by s: C<$E = elem_matrix_row_mult(5,2,4);> creates a 5 x 5 identity matrix and swaps puts 4 in the second spot on the diagonal. +=item Construct an n x n elementary matrix that will multiply row i by s: C<$E3 = elem_matrix_row_add(5,3,1,35);> -=item Construct an n x n elementary matrix that will multiply row i by s: C<$E3 = elem_matrix_row_add(5,3,1,35);> creates a 5 x 5 identity matrix and swaps puts 35 in the (3,1) position. +creates a 5 x 5 identity matrix and swaps puts 35 in the (3,1) position. -=item Perform the row switch transform that swaps (row i) with (row j): C<$Areduced = row_switch($A,2,4);> swaps rows 2 and 4 in matrix $A. +=item Perform the row switch transform that swaps (row i) with (row j): C<$Areduced = row_switch($A,2,4);> -=item Perform the row multiplication transform s * (row i) placed into (row i): C<$Areduced = row_mult(A,2,10);> multiplies every entry in row 2 of $A by 10. +swaps rows 2 and 4 in matrix $A. -=item Perform the row addition transform (row i) + s * (row j) placed into (row i): C<$Areduced = row_add($A,2,1,10);> adds 10 times row 1 to row 2 and places the result in row 2. (Same as constructing $E to be the identity with 10 placed in entry (2,1), then multiplying $E * $A.) +=item Perform the row multiplication transform s * (row i) placed into (row i): C<$Areduced = row_mult(A,2,10);> + +multiplies every entry in row 2 of $A by 10. + +=item Perform the row addition transform (row i) + s * (row j) placed into (row i): C<$Areduced = row_add($A,2,1,10);> + +adds 10 times row 1 to row 2 and places the result in row 2. (Same as constructing $E to be the identity with 10 placed in entry (2,1), then multiplying $E * $A.) =back @@ -42,61 +60,59 @@ =head1 DESCRIPTION Usage: -=over 12 - -DOCUMENT(); -loadMacros( -"PGstandard.pl", -"MathObjects.pl", -"MatrixReduce.pl", # automatically loads contextFraction.pl and MathObjects.pl -"PGcourse.pl", -); -$showPartialCorrectAnswers = 0; -TEXT(beginproblem()); - -# Context('Matrix'); # for decimal arithmetic -Context('Fraction'); # for fraction arithmetic - -$A = Matrix([ -[random(-5,5,1),random(-5,5,1),random(-5,5,1),3], -[random(-5,5,1),random(-5,5,1),random(-5,5,1),0.75], -[random(-5,5,1),random(-5,5,1),random(-5,5,1),9/4], -]); - -$A = apply_fraction_to_matrix_entries($A); # try commenting this line out for different results - -$Arref = rref($A); - -$Aswitch = row_switch($A, 2, 3); - -$Amult = row_mult($A, 2, 4); - -$Aadd = row_add($A, 2, 1, 10); - -$E = elem_matrix_row_add(3,2,1,10); -$EA = $E * $A; - -$E1 = elem_matrix_row_switch(5,2,4); -$E2 = elem_matrix_row_mult(5,4,Fraction(1/10)); -$E3 = elem_matrix_row_add(5,3,1,35); -$E4 = identity_matrix(4); -change_matrix_entry($E4,[3,2],10); - -Context()->texStrings; -BEGIN_TEXT -The original matrix and its row reduced echelon form: -\[ $A \sim $Arref. \] -$BR -The original matrix with rows switched, multiplied, or added together: -\[ $Aswitch, $Amult, $Aadd. \] -$BR -Some elementary matrices. -\[$E1, $E2, $E3, $E4\] -END_TEXT -Context()->normalStrings; - -COMMENT('MathObject version.'); -ENDDOCUMENT(); + DOCUMENT(); + loadMacros( + "PGstandard.pl", + "MathObjects.pl", + "MatrixReduce.pl", # automatically loads contextFraction.pl and MathObjects.pl + "PGcourse.pl", + ); + $showPartialCorrectAnswers = 0; + TEXT(beginproblem()); + + # Context('Matrix'); # for decimal arithmetic + Context('Fraction'); # for fraction arithmetic + + $A = Matrix([ + [random(-5,5,1),random(-5,5,1),random(-5,5,1),3], + [random(-5,5,1),random(-5,5,1),random(-5,5,1),0.75], + [random(-5,5,1),random(-5,5,1),random(-5,5,1),9/4], + ]); + + $A = apply_fraction_to_matrix_entries($A); # try commenting this line out for different results + + $Arref = rref($A); + + $Aswitch = row_switch($A, 2, 3); + + $Amult = row_mult($A, 2, 4); + + $Aadd = row_add($A, 2, 1, 10); + + $E = elem_matrix_row_add(3,2,1,10); + $EA = $E * $A; + + $E1 = elem_matrix_row_switch(5,2,4); + $E2 = elem_matrix_row_mult(5,4,Fraction(1/10)); + $E3 = elem_matrix_row_add(5,3,1,35); + $E4 = identity_matrix(4); + change_matrix_entry($E4,[3,2],10); + + Context()->texStrings; + BEGIN_TEXT + The original matrix and its row reduced echelon form: + \[ $A \sim $Arref. \] + $BR + The original matrix with rows switched, multiplied, or added together: + \[ $Aswitch, $Amult, $Aadd. \] + $BR + Some elementary matrices. + \[$E1, $E2, $E3, $E4\] + END_TEXT + Context()->normalStrings; + + COMMENT('MathObject version.'); + ENDDOCUMENT(); =back diff --git a/macros/PGmatrixmacros.pl b/macros/PGmatrixmacros.pl index 070646c63a..85698a4fce 100644 --- a/macros/PGmatrixmacros.pl +++ b/macros/PGmatrixmacros.pl @@ -4,7 +4,7 @@ =head1 NAME - Matrix macros for the PG language + PGmatrixmacros.pl =head1 SYNPOSIS @@ -12,11 +12,22 @@ =head1 SYNPOSIS =head1 DESCRIPTION -Almost all of the macros in the file are very rough at best. The most useful is display_matrix. -Many of the other macros work with vectors and matrices stored as anonymous arrays. +Matrix macros for the PG language -Frequently it may be -more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there. +These macros are fairly old. The most useful is display_matrix and +its variants. + +Frequently it will be +most useful to use the MathObjects Matrix (defined in Value::Matrix.pm) +and Vector types which +have more capabilities and more error checking than the subroutines in +this file. These macros have no object orientation and +work with vectors and matrices +stored as perl anonymous arrays. + +There are also Matrix objects defined in +RealMatrix.pm and Matrix.pm but in almost all cases the +MathObjects Matrix types are preferable. =cut @@ -28,132 +39,57 @@ BEGIN sub _PGmatrixmacros_init { } -# this subroutine zero_check is not very well designed below -- if it is used much it should receive -# more work -- particularly for checking relative tolerance. More work needs to be done if this is -# actually used. - -sub zero_check{ - my $array = shift; - my %options = @_; - my $num = @$array; - my $i; - my $max = 0; my $mm; - for ($i=0; $i< $num; $i++) { - $mm = $array->[$i] ; - $max = abs($mm) if abs($mm) > $max; - } - my $tol = $options{tol}; - $tol = 0.01*$options{reltol}*$options{avg} if defined($options{reltol}) and defined $options{avg}; - $tol = .000001 unless defined($tol); - ($max <$tol) ? 1: 0; # 1 if the array is close to zero; -} -sub vec_dot{ - my $vec1 = shift; - my $vec2 = shift; - warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. - my @vec1=@$vec1; - my @vec2=@$vec2; - my $sum = 0; - - while(@vec1) { - $sum += shift(@vec1)*shift(@vec2); - } - $sum; -} -sub proj_vec { - my $vec = shift; - warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; - my $matrix = shift; # the matrix represents a set of vectors spanning the linear space - # onto which we want to project the vector. - warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0]; - $matrix * transpose($matrix) * $vec; -} - -sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector - my $correct_vector = shift; - my %options = @_; - my $ans_eval = sub { - my $in = shift @_; - - my $ans_hash = new AnswerHash; - my @in = split("\0",$in); - my @correct_vector=@$correct_vector; - $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; - $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; - - return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension - - my $correct_length = vec_dot($correct_vector,$correct_vector); - my $in_length = vec_dot(\@in,\@in); - return($ans_hash) if $in_length == 0; - - if (defined($correct_length) and $correct_length != 0) { - my $constant = vec_dot($correct_vector,\@in)/$correct_length; - my @difference = (); - for(my $i=0; $i < @correct_vector; $i++ ) { - $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; - } - $ans_hash->{score} = zero_check(\@difference); - - } else { - $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; - } - $ans_hash; - - }; - - $ans_eval; -} ############ =head4 display_matrix - Usage \{ display_matrix( [ [1, '\(\sin x\)'], [ans_rule(5), 6] ]) \} - \{ display_matrix($A, align=>'crvl') \} - \[ \{ display_matrix_mm($A) \} \] - \[ \{ display_matrix_mm([ [1, 3], [4, 6] ]) \} \] - - display_matrix produces a matrix for display purposes. It checks whether - it is producing LaTeX output, or if it is displaying on a web page in one - of the various modes. The input can either be of type Matrix, Value::Matrix (mathobject) - or a reference to an array. - - Entries can be numbers, Fraction objects, bits of math mode, or answer - boxes. An entire row can be replaced by the string 'hline' to produce - a horizontal line in the matrix. - - display_matrix_mm functions similarly, except that it should be inside - math mode. display_matrix_mm cannot contain answer boxes in its entries. - Entries to display_matrix_mm should assume that they are already in - math mode. - - Both functions take an optional alignment string, similar to ones in - LaTeX tabulars and arrays. Here c for centered columns, l for left - flushed columns, and r for right flushed columns. - - The alignment string can also specify vertical rules to be placed in the - matrix. Here s or | denote a solid line, d is a dashed line, and v - requests the default vertical line. This can be set on a system-wide - or course-wide basis via the variable $defaultDisplayMatrixStyle, and - it can default to solid, dashed, or no vertical line (n for none). - - The matrix has left and right delimiters also specified by - $defaultDisplayMatrixStyle. They can be parentheses, square brackets, - braces, vertical bars, or none. The default can be overridden in - an individual problem with optional arguments such as left=>"|", or - right=>"]". - - You can specify an optional argument of 'top_labels'=> ['a', 'b', 'c']. - These are placed above the columns of the matrix (as is typical for - linear programming tableau, for example). The entries will be typeset - in math mode. - - Top labels require a bit of care. For image modes, they look better - with display_matrix_mm where it is all one big image, but they work with - display_matrix. With tth, you pretty much have to use display_matrix - since tth can't handle the TeX tricks used to get the column headers - up there if it gets the whole matrix at once. + Usage + \{ display_matrix( [ [1, '\(\sin x\)'], [ans_rule(5), 6] ]) \} + \{ display_matrix($A, align=>'crvl') \} + \[ \{ display_matrix_mm($A) \} \] + \[ \{ display_matrix_mm([ [1, 3], [4, 6] ]) \} \] + +display_matrix produces a matrix for display purposes. It checks whether +it is producing LaTeX output, or if it is displaying on a web page in one +of the various modes. The input can either be of type Matrix, Value::Matrix (mathobject) +or a reference to an array. + +Entries can be numbers, Fraction objects, bits of math mode, or answer +boxes. An entire row can be replaced by the string 'hline' to produce +a horizontal line in the matrix. + +display_matrix_mm functions similarly, except that it should be inside +math mode. display_matrix_mm cannot contain answer boxes in its entries. +Entries to display_matrix_mm should assume that they are already in +math mode. + +Both functions take an optional alignment string, similar to ones in +LaTeX tabulars and arrays. Here c for centered columns, l for left +flushed columns, and r for right flushed columns. + +The alignment string can also specify vertical rules to be placed in the +matrix. Here s or | denote a solid line, d is a dashed line, and v +requests the default vertical line. This can be set on a system-wide +or course-wide basis via the variable $defaultDisplayMatrixStyle, and +it can default to solid, dashed, or no vertical line (n for none). + +The matrix has left and right delimiters also specified by +$defaultDisplayMatrixStyle. They can be parentheses, square brackets, +braces, vertical bars, or none. The default can be overridden in +an individual problem with optional arguments such as left=>"|", or +right=>"]". + +You can specify an optional argument of 'top_labels'=> ['a', 'b', 'c']. +These are placed above the columns of the matrix (as is typical for +linear programming tableau, for example). The entries will be typeset +in math mode. + +Top labels require a bit of care. For image modes, they look better +with display_matrix_mm where it is all one big image, but they work with +display_matrix. With tth, you pretty much have to use display_matrix +since tth can't handle the TeX tricks used to get the column headers +up there if it gets the whole matrix at once. =cut @@ -692,6 +628,7 @@ sub mbox { =head4 ra_flatten_matrix Usage: ra_flatten_matrix($A) + returns: [a11, a12,a21,a22] where $A is a matrix object The output is a reference to an array. The matrix is placed in the array by iterating @@ -715,9 +652,17 @@ sub ra_flatten_matrix{ \@array; } -# This subroutine is probably obsolete and not generally useful. It was patterned after the APL -# constructs for multiplying matrices. It might come in handy for non-standard multiplication of -# of matrices (e.g. mod 2) for indice matrices. + +=head4 apl_matrix_mult() + + # This subroutine is probably obsolete and not generally useful. + # It was patterned after the APL + # constructs for multiplying matrices. It might come in handy + # for non-standard multiplication of + # of matrices (e.g. mod 2) for indice matrices. + +=cut + sub apl_matrix_mult{ my $ra_a= shift; my $ra_b= shift; @@ -763,9 +708,11 @@ sub make_matrix{ =head4 create2d_matrix -This can be a useful method for quickly entering small matrices by hand. --MEG +This can be a useful method for quickly entering small matrices by hand. + --MEG - create2d_matrix("1 2 4, 5 6 8"); + create2d_matrix("1 2 4, 5 6 8"); or + create2d_matrix("1 2 4; 5 6 8"); produces the anonymous array [[1,2,4],[5,6,8] ] @@ -775,11 +722,42 @@ =head4 create2d_matrix sub create2d_matrix { my $string = shift; - my @rows = split("\\s*,\\s*",$string); + my @rows = split("\\s*[,;]\\s*",$string); @rows = map {[split("\\s", $_ )]} @rows; [@rows]; } + +=head2 convert_to_array_ref { + + $output_matrix = convert_to_array_ref($input_matrix) + +Converts a MathObject matrix (ref($input_matrix eq 'Value::Matrix') +or a MatrixReal1 matrix (ref($input_matrix eq 'Matrix')to +a reference to an array (e.g [[4,6],[3,2]]). +This adaptor allows all of the LinearProgramming.pl subroutines to be used with +MathObject arrays. + +$mathobject_matrix->value outputs an array (usually an array of array references) so placing it inside +square bracket produces and array reference (of array references) which is what lp_display_mm() is +seeking. + +=cut + +sub convert_to_array_ref { + my $input = shift; + if (ref($input) eq 'Value::Matrix' ) { + $input = [$input->value]; + } elsif (ref($input) eq 'Matrix' ) { + $input = $input->array_ref; + } elsif (ref($input) =~/ARRAY/) { + # no change to input value + } else { + WARN_MESSAGE("This does not appear to be a matrix "); + } + $input; +} + =head4 check_matrix_from_ans_box_cmp An answer checker factory built on create2d_matrix. This still needs @@ -796,7 +774,6 @@ sub check_matrix_from_ans_box_cmp{ my $string_matrix_cmp = sub { $string = shift @_; my $studentMatrix; - # eval { $studentMatrix = Matrix(create2d_matrix($string)); die "I give up";}; #caught by op_mask $studentMatrix = Matrix(create2d_matrix($string)); die "I give up"; # main::DEBUG_MESSAGE(ref($studentMatrix). "$studentMatrix with error "); # errors are returned as warnings. Can't seem to trap them. @@ -815,67 +792,100 @@ sub check_matrix_from_ans_box_cmp{ } -=head2 convert_to_array_ref { - $output_matrix = convert_to_array_ref($input_matrix) +=head4 zero_check (deprecated -- use MathObjects matrices and vectors) -Converts a MathObject matrix (ref($input_matrix eq 'Value::Matrix') -or a MatrixReal1 matrix (ref($input_matrix eq 'Matrix')to -a reference to an array (e.g [[4,6],[3,2]]). -This adaptor allows all of the Linear Programming subroutines to be used with -MathObject arrays. + # this subroutine zero_check is not very well designed below -- if it is used much it should receive + # more work -- particularly for checking relative tolerance. More work needs to be done if this is + # actually used. -$mathobject_matrix->value outputs an array (usually an array of array references) so placing it inside -square bracket produces and array reference (of array references) which is what lp_display_mm() is -seeking. +=cut + +sub zero_check{ + my $array = shift; + my %options = @_; + my $num = @$array; + my $i; + my $max = 0; my $mm; + for ($i=0; $i< $num; $i++) { + $mm = $array->[$i] ; + $max = abs($mm) if abs($mm) > $max; + } + my $tol = $options{tol}; + $tol = 0.01*$options{reltol}*$options{avg} if defined($options{reltol}) and defined $options{avg}; + $tol = .000001 unless defined($tol); + ($max <$tol) ? 1: 0; # 1 if the array is close to zero; +} + +=head4 vec_dot() (deprecated -- use MathObjects vectors and matrices) + +sub vec_dot{ + my $vec1 = shift; + my $vec2 = shift; + warn "vectors must have the same length" unless @$vec1 == @$vec2; # the vectors must have the same length. + my @vec1=@$vec1; + my @vec2=@$vec2; + my $sum = 0; + + while(@vec1) { + $sum += shift(@vec1)*shift(@vec2); + } + $sum; +} + +=head4 proj_vect (deprecated -- use MathObjects vectors and matrices) =cut -sub convert_to_array_ref { - my $input = shift; - if (ref($input) eq 'Value::Matrix' ) { - $input = [$input->value]; - } elsif (ref($input) eq 'Matrix' ) { - $input = $input->array_ref; - } elsif (ref($input) =~/ARRAY/) { - # no change to input value - } else { - WARN_MESSAGE("This does not appear to be a matrix "); - } - $input; +sub proj_vec { + my $vec = shift; + warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; + my $matrix = shift; # the matrix represents a set of vectors spanning the linear space + # onto which we want to project the vector. + warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0]; + $matrix * transpose($matrix) * $vec; +} + +=head4 vec_cmp (deprecated -- use MathObjects vectors and matrices) + +=cut + + +sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector + my $correct_vector = shift; + my %options = @_; + my $ans_eval = sub { + my $in = shift @_; + + my $ans_hash = new AnswerHash; + my @in = split("\0",$in); + my @correct_vector=@$correct_vector; + $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; + $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; + + return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension + + my $correct_length = vec_dot($correct_vector,$correct_vector); + my $in_length = vec_dot(\@in,\@in); + return($ans_hash) if $in_length == 0; + + if (defined($correct_length) and $correct_length != 0) { + my $constant = vec_dot($correct_vector,\@in)/$correct_length; + my @difference = (); + for(my $i=0; $i < @correct_vector; $i++ ) { + $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; + } + $ans_hash->{score} = zero_check(\@difference); + + } else { + $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; + } + $ans_hash; + + }; + + $ans_eval; } -# sub format_answer{ -# my $ra_eigenvalues = shift; -# my $ra_eigenvectors = shift; -# my $functionName = shift; -# my @eigenvalues=@$ra_eigenvalues; -# my $size= @eigenvalues; -# my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); -# my $out = qq! -# $functionName(t) =! . -# displayMatrix(apl_matrix_mult($ra_eigenvectors,$ra_eigen, -# 'times'=>sub{($_[0] and $_[1]) ? "$_[0]$_[1]" : ''}, -# 'plus'=>sub{ my $out = join("",@_); ($out) ?$out : '0' } -# ) ) ; -# $out; -# } -# sub format_vector_answer{ -# my $ra_eigenvalues = shift; -# my $ra_eigenvectors = shift; -# my $functionName = shift; -# my @eigenvalues=@$ra_eigenvalues; -# my $size= @eigenvalues; -# my $ra_eigen = make_matrix( sub {my ($i,$j) = @_; ($i==$j) ? "e^{$eigenvalues[$j] t}": 0 }, $size,$size); -# my $out = qq! -# $functionName(t) =! . -# displayMatrix($ra_eigenvectors)."e^{$eigenvalues[0] t}" ; -# $out; -# } -# sub format_question{ -# my $ra_matrix = shift; -# my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! -# -# } 1; diff --git a/macros/PGmorematrixmacros.pl b/macros/PGmorematrixmacros.pl index b2af761786..8ed22573a9 100644 --- a/macros/PGmorematrixmacros.pl +++ b/macros/PGmorematrixmacros.pl @@ -5,9 +5,24 @@ BEGIN # set the prefix used for arrays. our $ArRaY = $main::PG->{ARRAY_PREFIX}; +=head2 NAME + + macros/PGmorematrixmacros.pl + +=cut + + sub _PGmorematrixmacros_init{} -sub random_inv_matrix { ## Builds and returns a random invertible \$row by \$col matrix. +=head4 random_inv_matrix + +## Builds and returns a random invertible \$row by \$col matrix. + +=cut + + +sub random_inv_matrix { +## Builds and returns a random invertible \$row by \$col matrix. warn "Usage: \$new_matrix = random_inv_matrix(\$rows,\$cols)" if (@_ != 2); @@ -54,16 +69,29 @@ sub random_diag_matrix{ ## Builds and returns a random diagonal \$n by \$n matri return $D; } +=head4 swap_rows ($matrix, $row1, $row2) + + (deprecated use MathObject Matrix instead) + +$matrix is assumed to be a RealMatrix1 object. +It is better to use MathObject Matrices and row swap mechanisms +from MatrixReduce.pl instead. + +=cut + + sub swap_rows{ warn "Usage: \$new_matrix = swap_rows(\$matrix,\$row1,\$row2);" if (@_ != 3); my $matrix = $_[0]; my ($i,$j) = ($_[1],$_[2]); + warn "Error: Rows to be swapped must exist!" if ($i>@$matrix or $j >@$matrix); warn "Warning: Swapping the same row is pointless" - if ($i==$j); + if ($i==$j); + my $cols = @{$matrix->[0]}; my $B = new Matrix(@$matrix,$cols); foreach my $k (1..$cols){ @@ -73,6 +101,16 @@ sub swap_rows{ return $B; } +=head4 row_mult ($matrix, $scaler, $row) + + (deprecated use MathObject Matrix instead) + +$matrix is assumed to be a RealMatrix1 object. +It is better to use MathObject Matrices and row swap mechanisms +from MatrixReduce.pl instead. + +=cut + sub row_mult{ warn "Usage: \$new_matrix = row_mult(\$matrix,\$scalar,\$row);" @@ -88,6 +126,16 @@ sub row_mult{ return $B; } +sub linear_combo($matrix, $scalar, $row1, $row2) + + (deprecated use MathObject Matrix instead) + +Adds a multiple of row1 to row2. + +$matrix is assumed to be a RealMatrix1 object. +It is better to use MathObject Matrices and subroutines +from MatrixReduce.pl instead. + sub linear_combo{ warn "Usage: \$new_matrix = linear_combo(\$matrix,\$scalar,\$row1,\$row2);" @@ -106,6 +154,15 @@ sub linear_combo{ return $B; } + +=head2 + +These should be compared to similar subroutines made later in +MatrixCheckers.pl + + +=cut + =head3 basis_cmp() Compares a list of vectors by finding the change of coordinate matrix @@ -378,6 +435,8 @@ sub compare_basis { =head2 vec_list_string +(this is mostly obsolete. One should use MathObject Vectors instead. ) + This is a check_syntax type method (in fact I borrowed some of that method's code) for vector input. The student needs to enter vectors like: [1,0,0],[1,2,3],[0,9/sqrt(10),1/sqrt(10)] Each entry can contain functions and operations and the usual math constants (pi and e). @@ -503,8 +562,14 @@ sub vec_list_string{ $rh_ans; } + + + =head5 ans_array_filter + (this filter is not necessary when using MathObjects. It may someday be useful + again if the AnswerEvaluator pipeline is used to its fullest extent. ) + This filter was created to get, format, and evaluate each entry of the ans_array and ans_array_extension answer entry methods. Running this filter is necessary to get all the entries out of the answer hash. Each entry is evaluated and the resulting number is put in the display for student answer @@ -616,6 +681,20 @@ sub ans_array_filter{ } +=head3 + +The following subroutines, meant to be used with MatrixReal1 type matrices, are +deprecated. In general you should use the MathObject Matrix type and the +checking methods in MatrixCheckers.pl + + are_orthogonal_vecs($vec_ref, %opts) + is_diagonal($matrix, %opts) + are_unit_vecs($vec_ref, %opts) + display_correct_vecs($vec_ref, %opts) + vec_solution_cmp($vec,%opts) + filter: compare_vec_solution($rh_ans,%opts); + +=cut sub are_orthogonal_vecs{ my ($vec_ref , %opts) = @_; diff --git a/macros/quickMatrixEntry.pl b/macros/quickMatrixEntry.pl index 10150f50c9..1f1601639c 100755 --- a/macros/quickMatrixEntry.pl +++ b/macros/quickMatrixEntry.pl @@ -7,13 +7,12 @@ sub _quickMatrixEntry_init {}; # don't reload this file sub INITIALIZE_QUICK_MATRIX_ENTRY { - main::HEADER_TEXT($quick_entry_javascript); - main::TEXT($quick_entry_form); + main::HEADER_TEXT(main::MODES(HTML=>$quick_entry_javascript, TeX=>'')); + main::TEXT(MODES(HTML=>$quick_entry_form, TeX=>'')); return ''; } -# + sub MATRIX_ENTRY_BUTTON { my $answer_number = shift; # warn(" input reference is ". ref($answer_number)); @@ -28,13 +27,17 @@ sub MATRIX_ENTRY_BUTTON { $columns=$columns//5; my $answer_name = "AnSwEr".sprintf('%04d',$answer_number); # warn("answer number $answer_name rows $rows columns $columns"); - return qq! - $PAR - - $PAR!; + return MODES( + HTML => qq!$PAR + + $PAR!, + TeX => qq!$PAR Quick Matrix Entry Button $PAR!, + ); } + + our $quick_entry_javascript = <<'END_JS';