Merge pull request #310 from openwebwork/PG-2.13

PG-2.13

LICENSE

@@ -2,7 +2,7 @@
                          Online Homework Delivery System                        
                                    Version 2.*                                 
 
-                    Copyright 2000-2016, The WeBWorK Project                    
+                    Copyright 2000-2017, The WeBWorK Project                    
                               All rights reserved.                              
 
     This program is free software; you can redistribute it and/or modify

README

@@ -6,6 +6,6 @@
 
 		http://webwork.maa.org/wiki/Category:Release_Notes  
 
-                    Copyright 2000-2014, The WeBWorK Project
+                    Copyright 2000-2017, The WeBWorK Project
                              http://webwork.maa.org
                               All rights reserved.                             

VERSION

@@ -1,4 +1,4 @@
-$PG_VERSION  ='2.12';
-$PG_COPYRIGHT_YEARS = '1996-2016';
+$PG_VERSION  ='PG-2.13';
+$PG_COPYRIGHT_YEARS = '1996-2017';
 
 1;

lib/PGcore.pm

@@ -112,7 +112,8 @@ sub initialize {
 												WARNING_messages => $self->{WARNING_messages},
 												DEBUG_messages   => $self->{DEBUG_messages},                                           
 										);
-	$self->{maketext} =  WeBWorK::Localize::getLoc($self->{envir}->{language});
+	#$self->{maketext} =  WeBWorK::Localize::getLoc($self->{envir}->{language});
+	$self->{maketext} = $self->{envir}->{language_subroutine};
 	#$self->debug_message("PG alias created", $self->{PG_alias} );
     $self->{PG_loadMacros}        = new PGloadfiles($self->{envir});
 	$self->{flags} = {
@@ -490,6 +491,8 @@ sub record_array_name {  # currently the same as record ans name
 	$label;
 
 }
+
+
 sub extend_ans_group {         # modifies the group type
 	my $self = shift;
 	my $label = shift;
@@ -506,6 +509,7 @@ sub extend_ans_group {         # modifies the group type
     }
     $label;
 }
+
 sub record_unlabeled_ans_name {
 	my $self = shift;
     $self->{unlabeled_answer_blank_count}++;
@@ -720,8 +724,11 @@ sub insertGraph {
 
 =cut
 sub maketext {
-    my $self = shift;
-	&{ $self->{maketext}}(@_);
+  my $self = shift;
+  # uncomment this to check to see if strings are run through
+  # maketext.  
+  # return 'xXx'.  &{ $self->{maketext}}(@_).'xXx';
+  &{ $self->{maketext}}(@_);
 }
 sub includePGtext { 
 	my $self = shift;

lib/Parser/Differentiation.pm

@@ -100,7 +100,8 @@ sub Parser::BOP::divide::D {
         $BOP->new($equation,'*',
           $self->{lop}->copy($equation),$self->{rop}->D($x))
       ),
-      $BOP->new($equation,'^',$self->{rop},$self->Item("Number")->new($equation,2))
+      $BOP->new($equation,'^',$self->{rop}->copy($equation),
+        $self->Item("Number")->new($equation,2))
     );
   return $self->reduce;
 }

lib/Parser/Legacy/NumberWithUnits.pm

@@ -7,6 +7,12 @@
 
 package Parser::Legacy::ObjectWithUnits;
 
+# Refrences to problem specific copies of %Units::fundamental_units
+# and %Units::known_units.  These should be passed to any Units function call.
+# They are set by the initializeUnits sub
+my $fundamental_units = '';
+my $known_units = '';
+
 sub name {'object'};
 sub cmp_class {'an Object with Units'};
 sub makeValue {
@@ -15,10 +21,46 @@ sub makeValue {
   Value::makeValue($value,%options);
 }
 
+sub initializeUnits {
+  $fundamental_units = shift;
+  $known_units = shift;
+}
+
 sub new {
   my $self = shift; my $class = ref($self) || $self;
   my $context = (Value::isContext($_[0]) ? shift : $self->context);
-  my $num = shift; my $units = shift;
+  my $num = shift;
+  # we need to check if units is the options hash
+  my $units = shift;
+  my $options;
+
+  if (ref($units) eq 'HASH') {
+    $options = $units;
+    $units = '';
+  } else {
+    $options = shift;
+  }
+
+  # register a new unit/s if needed
+  if (defined($options->{newUnit})) {
+    my @newUnits;
+    if (ref($options->{newUnit}) eq 'ARRAY') {
+      @newUnits = @{$options->{newUnit}};
+    } else {
+      @newUnits = ($options->{newUnit});
+    }
+
+    foreach my $newUnit (@newUnits) {
+      if (ref($newUnit) eq 'HASH') {
+	add_unit($newUnit->{name}, $newUnit->{conversion});
+      } else {
+	add_unit($newUnit);
+      }
+    }
+  }
+
+
+
   Value::Error("You must provide a ".$self->name) unless defined($num);
   ($num,$units) = splitUnits($num) unless $units;
   Value::Error("You must provide units for your ".$self->name) unless $units;
@@ -37,17 +79,18 @@ sub new {
 #
 #  Find the units for the formula and split that off
 #
-my $aUnit = '(?:'.getUnitNames().')(?:\s*(?:\^|\*\*)\s*[-+]?\d+)?';
-my $unitPattern = $aUnit.'(?:\s*[/* ]\s*'.$aUnit.')*';
-my $unitSpace = "($aUnit) +($aUnit)";
 sub splitUnits {
+  my $aUnit = '(?:'.getUnitNames().')(?:\s*(?:\^|\*\*)\s*[-+]?\d+)?';
+  my $unitPattern = $aUnit.'(?:\s*[/* ]\s*'.$aUnit.')*';
+  my $unitSpace = "($aUnit) +($aUnit)";
   my $string = shift;
-  my ($num,$units) = $string =~ m!^(.*?(?:[)}\]0-9a-z]|\d\.))\s*($unitPattern)\s*$!o;
+  my ($num,$units) = $string =~ m!^(.*?(?:[)}\]0-9a-z]|\d\.))\s*($unitPattern)\s*$!;
   if ($units) {
     while ($units =~ s/$unitSpace/$1*$2/) {};
     $units =~ s/ //g;
     $units =~ s/\*\*/^/g;
   }
+
   return ($num,$units);
 }
 
@@ -57,18 +100,29 @@ sub splitUnits {
 #
 sub getUnitNames {
   local ($a,$b);
+  my $units = \%Units::known_units;
+  if ($known_units) {
+    $units = $known_units;
+  }
   join('|',sort {
     return length($b) <=> length($a) if length($a) != length($b);
     return $a cmp $b;
-  } keys(%Units::known_units));
+  } keys(%$units));
 }
 
 #
 #  Get the units hash and fix up the errors
 #
 sub getUnits {
   my $units = shift;
-  my %Units = Units::evaluate_units($units);
+  my $options = {};
+  if ($fundamental_units) {
+    $options->{fundamental_units} = $fundamental_units;
+  }
+  if ($known_units) {
+    $options->{known_units} = $known_units;
+  }
+  my %Units = Units::evaluate_units($units,$options);
   if ($Units{ERROR}) {
     $Units{ERROR} =~ s/ at ([^ ]+) line \d+(\n|.)*//;
     $Units{ERROR} =~ s/^UNIT ERROR:? *//;
@@ -104,6 +158,7 @@ sub cmp_parse {
   #
   #  Check that the units are defined and legal
   #
+
   my ($num,$units) = splitUnits($ans->{student_ans});
   unless (defined($num) && defined($units) && $units ne '') {
     $self->cmp_Error($ans,"Your answer doesn't look like ".lc($self->cmp_class));
@@ -157,6 +212,31 @@ sub adjustCorrectValue {
 
 sub cmp_reparse {Value::cmp_parse(@_)}
 
+sub add_fundamental_unit {
+  my $unit = shift;
+  $fundamental_units->{$unit} = 0;
+}
+
+sub add_unit {
+  my $unit = shift;
+  my $hash = shift;
+
+  unless (ref($hash) eq 'HASH') {
+    $hash = {'factor'    => 1,
+	     "$unit"     => 1 };
+  }
+
+  # make sure that if this unit is defined in terms of any other units
+  # then those units are fundamental units.  
+  foreach my $subUnit (keys %$hash) {
+    if (!defined($fundamental_units->{$subUnit})) {
+      add_fundamental_unit($subUnit);
+    }
+  }
+
+  $known_units->{$unit} = $hash;
+}
+
 ######################################################################
 
 #

lib/Rserve.pm

@@ -0,0 +1,67 @@
+package Rserve;
+
+use strict;
+use warnings;
+
+my $rserve_loaded = eval {
+    require Statistics::R::IO::Rserve;
+    1
+};
+
+sub access {
+    die 'Statistics::R::IO::Rserve could not be loaded. Have you installed the module?'
+        unless $rserve_loaded;
+
+    Statistics::R::IO::Rserve->new(@_)
+};
+
+
+## Evaluates an R expression guarding it inside an R `try` function
+##
+## Returns the result as a REXP if no exceptions were raised, or
+## `die`s with the text of the exception message.
+sub try_eval {
+    my ($rserve, $query) = @_;
+
+    my $result = $rserve->eval("try({ $query }, silent=TRUE)");
+    die $result->to_pl->[0] if _inherits($result, 'try-error');
+    # die $result->to_pl->[0] if $result->inherits('try-error');
+
+    $result
+}
+
+
+## Returns a REXP's Perl representation, dereferencing it if it's an
+## array reference
+##
+## `REXP::to_pl` returns a string scalar for Symbol, undef for Null,
+## and an array reference to contents for all vector types. This
+## function is a utility wrapper to make it easy to assign a Vector's
+## representation to an array variable, while still working sensibly
+## for non-arrays.
+sub unref_rexp {
+    my $rexp = shift;
+
+    my $value = $rexp->to_pl;
+    if (ref($value) eq ref([])) {
+        @{$value}
+    } else {
+        $value
+    }
+}
+
+
+## Reimplements method C<inherits> of class L<Statistics::R::REXP>
+## until I figure out why calling it directly doesn't work in the safe
+## compartment
+sub _inherits {
+    my ($rexp, $class) = @_;
+
+    my $attributes = $rexp->attributes;
+    return unless $attributes && $attributes->{'class'};
+
+    grep {/^$class$/} @{$attributes->{'class'}->to_pl}
+}
+
+
+1;