From 4a7c590e8ab3ab23f5713dbaa06d7d078d7102c3 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 29 Nov 2012 08:58:28 -0800 Subject: [PATCH 01/15] Merge from upstream HEAD. --- lib/Parser/BOP/power.pm | 2 +- lib/Parser/Context/Variables.pm | 2 +- lib/Parser/Item.pm | 2 +- lib/Value/AnswerChecker.pm | 17 +++--- lib/Value/Context.pm | 2 +- lib/Value/Context/Data.pm | 2 +- lib/Value/Real.pm | 4 +- lib/WeBWorK/PG/IO.pm | 21 ++++--- lib/WeBWorK/PG/Translator.pm | 29 ++------- macros/PG.pl | 2 +- macros/PGML.pl | 10 ++-- macros/PGanswermacros.pl | 4 +- macros/PGstatisticsmacros.pl | 53 ++++++++++++++++ macros/parserFormulaUpToConstant.pl | 10 ++-- macros/parserMultiAnswer.pl | 3 +- macros/unionTables.pl | 93 ++++++++++++++++++++--------- 16 files changed, 169 insertions(+), 87 deletions(-) diff --git a/lib/Parser/BOP/power.pm b/lib/Parser/BOP/power.pm index ef09ec9..c7275ca 100644 --- a/lib/Parser/BOP/power.pm +++ b/lib/Parser/BOP/power.pm @@ -31,7 +31,7 @@ sub _check { sub _eval { my $self = $_[0]; my $x = $_[1] ** $_[2]; - return $x unless $x eq 'nan'; + return $x unless lc($x) eq 'nan' or lc($x) eq "-nan"; $self->Error("Can't raise a negative number to a non-integer power") if Value::isNumber($_[1]) && Value::makeValue($_[1],context=>$self->context)->value < 0; $self->Error("Result of exponentiation is not a number"); diff --git a/lib/Parser/Context/Variables.pm b/lib/Parser/Context/Variables.pm index 38ed43b..722ed42 100644 --- a/lib/Parser/Context/Variables.pm +++ b/lib/Parser/Context/Variables.pm @@ -36,7 +36,7 @@ sub init { #sub removeToken {} # -# If the type is one of the names ones, use it's known type +# If the type is one of the named ones, use it's known type # Otherwise if it is a Value object use its type, # Otherwise, if it is a signed number, use the Real type # Otherwise report an error diff --git a/lib/Parser/Item.pm b/lib/Parser/Item.pm index 90629bd..593037d 100644 --- a/lib/Parser/Item.pm +++ b/lib/Parser/Item.pm @@ -39,7 +39,7 @@ sub Item { my $self = shift; my $class = shift; my $context = (Value::isContext($_[0]) ? shift : $self->context); return $context->{parser}{$class} if defined $context->{parser}{$class}; - return "Parser::$class" if defined @{"Parser::${class}::ISA"}; + return "Parser::$class" if @{"Parser::${class}::ISA"}; Value::Error("No such package 'Parser::%s'",$class); } diff --git a/lib/Value/AnswerChecker.pm b/lib/Value/AnswerChecker.pm index 48dfa36..d44b9d1 100644 --- a/lib/Value/AnswerChecker.pm +++ b/lib/Value/AnswerChecker.pm @@ -1927,13 +1927,11 @@ sub cmp_graph { # my %options = (title=>'',points=>[],@_); my $graphs = $diagnostics->{graphs}; - my $limits = $graphs->{limits}; $limits = $self->getFlag('limits',[-2,2]) unless $limits; - $limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY'; + my $limits = $graphs->{limits}; my $size = $graphs->{size}; $size = [$size,$size] unless ref($size) eq 'ARRAY'; my $steps = $graphs->{divisions}; my $points = $options{points}; my $clip = $options{clip}; - my ($my,$My) = (0,0); my ($mx,$Mx) = @{$limits}; - my $dx = ($Mx-$mx)/$steps; my $f; my $y; + my ($my,$My) = (0,0); my ($mx,$Mx); my $dx; my $f; my $y; my @pnames = $self->{context}->variables->parameters; my @pvalues = ($self->{parameters} ? @{$self->{parameters}} : (0) x scalar(@pnames)); @@ -1959,10 +1957,13 @@ sub cmp_graph { $self->{graphWarning} = 1; return ""; } - unless ($f->typeRef->{length} == 1) { - warn "Only real-valued functions can be graphed"; - return ""; - } + + $x = ($f->{context}->variables->names)[0] unless $x; + $limits = [$self->getVariableLimits($x)] unless $limits; + $limits = $limits->[0] while ref($limits) eq 'ARRAY' && ref($limits->[0]) eq 'ARRAY'; + ($mx,$Mx) = @{$limits}; + $dx = ($Mx-$mx)/$steps; + if ($f->isConstant) { $y = $f->eval; $my = $y if $y < $my; $My = $y if $y > $My; diff --git a/lib/Value/Context.pm b/lib/Value/Context.pm index f6b9df8..70aa56b 100644 --- a/lib/Value/Context.pm +++ b/lib/Value/Context.pm @@ -102,7 +102,7 @@ sub Package { return $context->{value}{$class} if defined $context->{value}{$class}; $class =~ s/\(\)$//; return $context->{value}{$class} if defined $context->{value}{$class}; - return "Value::$class" if defined @{"Value::${class}::ISA"}; + return "Value::$class" if @{"Value::${class}::ISA"}; Value::Error("No such package 'Value::%s'",$class) unless $_[0]; } diff --git a/lib/Value/Context/Data.pm b/lib/Value/Context/Data.pm index 3c5859e..34e6c87 100644 --- a/lib/Value/Context/Data.pm +++ b/lib/Value/Context/Data.pm @@ -13,7 +13,7 @@ sub new { context => $parent, # parent context dataName => {}, # name of data storage in context hash tokens => {}, # hash of id => type specifications that will be made into a pattern - patterns => {}, # hash of pattern => [type,precedence] specification for extra patterns + patterns => {}, # hash of pattern => [precedence,type] specification for extra patterns tokenType => {}, # type of Parser token for these pattern namePattern => '', # pattern for allowed names for new items name => '', Name => '', # lower- and upper-case names for the class of items diff --git a/lib/Value/Real.pm b/lib/Value/Real.pm index 2b4550d..a64da7a 100644 --- a/lib/Value/Real.pm +++ b/lib/Value/Real.pm @@ -36,7 +36,7 @@ sub new { sub make { my $self = shift; my $n = (Value::isContext($_[0]) ? $_[1] : $_[0]); - return $self->SUPER::make(@_) unless "$n" eq "nan"; + return $self->SUPER::make(@_) unless lc("$n") eq "nan" or lc("$n") eq "-nan"; Value::Error("Result is not a real number"); } @@ -95,7 +95,7 @@ sub div { sub power { my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_); my $x = $l->{data}[0] ** $r->{data}[0]; - return $self->inherit($other)->make($x) unless $x eq 'nan'; + return $self->inherit($other)->make($x) unless lc($x) eq 'nan' or lc($x) eq '-nan'; Value::Error("Can't raise a negative number to a non-integer power") if ($l->{data}[0] < 0); Value::Error("Result of exponention is not a number"); } diff --git a/lib/WeBWorK/PG/IO.pm b/lib/WeBWorK/PG/IO.pm index bf87386..e6acf41 100644 --- a/lib/WeBWorK/PG/IO.pm +++ b/lib/WeBWorK/PG/IO.pm @@ -5,6 +5,7 @@ package WeBWorK::PG::IO; use base qw(Exporter); +use WeBWorK::PG::Translator; =head1 NAME @@ -67,10 +68,11 @@ contains the function. =item includePGtext($string_ref, $envir_ref) -Calls C recursively with the $safeCompartment variable set to 0 so -that the rendering continues in the current safe compartment. The output is the -same as the output from createPGtext. This is used in processing some of the -sample CAPA files. + +This is used in processing some of the sample CAPA files and in creating aliases to redirect calls to duplicate problems so that +they go to the original problem instead. It is called by includePGproblem. + +It reads and evaluates the string in the same way that the Translator evaluates the string in a PG file. =cut @@ -79,12 +81,15 @@ sub includePGtext { if (ref($evalString) eq 'SCALAR') { $evalString = $$evalString; } - $evalString =~ s/\nBEGIN_TEXT/\nTEXT\(EV3\(<<'END_TEXT'\)\);/g; - $evalString =~ s/\\/\\\\/g; # \ can't be used for escapes because of TeX conflict - $evalString =~ s/~~/\\/g; # use ~~ as escape instead, use # for comments +# $evalString =~ s/\nBEGIN_TEXT/\nTEXT\(EV3\(<<'END_TEXT'\)\);/g; +# $evalString =~ s/\\/\\\\/g; # \ can't be used for escapes because of TeX conflict +# $evalString =~ s/~~/\\/g; # use ~~ as escape instead, use # for comments no strict; - eval("package main; $evalString") ; + $evalString = eval( q! &{$main::PREPROCESS_CODE}($evalString) !); + # current preprocessing code passed from Translator (see Translator::initialization) my $errors = $@; + eval("package main; $evalString") ; + $errors .= $@; die eval(q! "ERROR in included file:\n$main::envir{probFileName}\n $errors\n$evalString"!) if $errors; use strict; return ""; diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index bc98b72..4004b0c 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -288,6 +288,8 @@ sub initialize { $safe_cmpt -> share('%envir'); #local($rf_answer_eval) = sub { $self->PG_answer_eval(@_); }; #local($rf_restricted_eval) = sub { $self->PG_restricted_eval(@_); }; + local($PREPROCESS_CODE) = sub {&{$self->{preprocess_code}} ( @_ ) }; + $safe_cmpt -> share ('$PREPROCESS_CODE'); # for the benefit of IO::includePGtext() #$safe_cmpt -> share('$rf_answer_eval'); #$safe_cmpt -> share('$rf_restricted_eval'); use strict; @@ -1561,28 +1563,8 @@ sub PGsort { } -=head2 includePGtext - includePGtext($string_ref, $envir_ref) - -Calls C recursively with the $safeCompartment variable set to 0 -so that the rendering continues in the current safe compartment. The output -is the same as the output from createPGtext. This is used in processing -some of the sample CAPA files. - -=cut - -#this is a method for importing additional PG files from within one PG file. -# sub includePGtext { -# my $self = shift; -# my $string_ref =shift; -# my $envir_ref = shift; -# $self->environment($envir_ref); -# $self->createPGtext($string_ref); -# } -# evaluation macros - -no strict; # this is important -- I guess because eval operates on code which is not written with strict in mind. +# no strict; # this is important -- I guess because eval operates on code which is not written with strict in mind. =head2 PG_restricted_eval @@ -1651,7 +1633,7 @@ since at some point one might like to make the answer evaluations more stringent sub PG_answer_eval { - local($string) = shift; # I made this local just in case -- see PG_restricted_eval + my($string) = shift; # I made this local just in case -- see PG_restricted_eval my $errors = ''; my $full_error_report = ''; my ($pck,$file,$line) = caller; @@ -1665,7 +1647,7 @@ sub PG_answer_eval { # We seem to need PG_priv instead of main when PG_answer_eval is called within a completion # 'package PG_priv; ' - local $SIG{__WARN__} = sub {die(@_)}; # make warn die, so all errors are reported. + local $SIG{__WARN__} = sub {die(@_)}; # make warn die, so all errors are reported. local $SIG{__DIE__} = "DEFAULT"; no strict; @@ -1719,6 +1701,7 @@ sub default_postprocess_code { $evalString_ref; } +no strict; sub dumpvar { my ($packageName) = @_; diff --git a/macros/PG.pl b/macros/PG.pl index c9be1ae..b893731 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -647,7 +647,7 @@ sub includePGproblem { DEBUG_messages => $PG->{DEBUG_messages}, ); $PG->{PG_alias}=$temp_PGalias; - includePGtext($r_string); + $PG->includePGtext($r_string); # Reset the environment to what it was before. %main::envir = %save_envir; $PG->{PG_alias}=$save_PGalias; diff --git a/macros/PGML.pl b/macros/PGML.pl index cff1770..8ea7bc5 100644 --- a/macros/PGML.pl +++ b/macros/PGML.pl @@ -1,6 +1,3 @@ -loadMacros("contextTypeset.pl"); - - ###################################################################### ###################################################################### @@ -1273,7 +1270,7 @@ sub Format2 { % definitions for PGML % -\ifx\pgmlCount\undefined % don not redefine if multiple files load PGML.pl +\ifx\pgmlCount\undefined % do not redefine if multiple files load PGML.pl \newcount\pgmlCount \newdimen\pgmlPercent \newdimen\pgmlPixels \pgmlPixels=.5pt @@ -1348,12 +1345,15 @@ sub Format2 { package main; sub _PGML_init { + my $context = Context; # prevent Typeset context from becoming active + loadMacros("contextTypeset.pl"); + Context($context); $problemPreamble->{TeX} .= $PGML::preamble unless $problemPreamble->{TeX} =~ m/definitions for PGML/; if (defined($BR)) { ## Avoid bad spacing at the top of the problem (need to modify hardcopyPreamble.tex) TEXT(MODES(HTML=>'', TeX=>' \ifx\pgmlMarker\undefined - \newdimen\pgmlMarker \pgmlMarker=0.00314159pt % hack to lett if \newline was used + \newdimen\pgmlMarker \pgmlMarker=0.00314159pt % hack to tell if \newline was used \fi \ifx\oldnewline\undefined \let\oldnewline=\newline \fi \def\newline{\oldnewline\hskip-\pgmlMarker\hskip\pgmlMarker\relax}% diff --git a/macros/PGanswermacros.pl b/macros/PGanswermacros.pl index 569eb07..323be35 100644 --- a/macros/PGanswermacros.pl +++ b/macros/PGanswermacros.pl @@ -1521,7 +1521,7 @@ sub std_problem_grader { $problem_state{num_of_correct_ans}++ if $allAnswersCorrectQ == 1; $problem_state{num_of_incorrect_ans}++ if $allAnswersCorrectQ == 0; - + $problem_state{recorded_score} = 0 unless defined $problem_state{recorded_score}; # Determine if we are in the reduced scoring period and act accordingly my $reducedScoringPeriodSec = $reducedScoringPeriod*60; # $reducedScoringPeriod is in minutes @@ -1624,6 +1624,7 @@ sub std_problem_grader2 { } # report the results $problem_result{score} = $allAnswersCorrectQ; + $problem_state{recorded_score} = 0 unless defined $problem_state{recorded_score}; # Determine if we are in the reduced scoring period and act accordingly @@ -1715,6 +1716,7 @@ sub avg_problem_grader { } # Calculate score rounded to three places to avoid roundoff problems $problem_result{score} = $total/$count if $count; + $problem_state{recorded_score} = 0 unless defined $problem_state{recorded_score}; $problem_state{num_of_correct_ans}++ if $total == $count; $problem_state{num_of_incorrect_ans}++ if $total < $count; diff --git a/macros/PGstatisticsmacros.pl b/macros/PGstatisticsmacros.pl index 87b0140..527f0f3 100644 --- a/macros/PGstatisticsmacros.pl +++ b/macros/PGstatisticsmacros.pl @@ -107,6 +107,59 @@ sub normal_distr { $b; } + +=head3 Mean function + +=pod + + Usage: stats_mean(@data); + +Computes the artihmetic mean of a list of numbers, data. You may also pass the numbers individually. + +=cut + +sub stats_mean { + my @data_list = @_; + + my $total = 0; + + foreach ( @data_list ) { + $total=$total + $_; + } + + my $n = @data_list; + return( $total/$n ); + +} + +=head3 Standard Deviation function + +=pod + + Usage: stats_sd(@data); + +Computes the sample standard deviation of a list of numbers, data. You may also pass the numbers individually. + +=cut + +sub stats_sd { + my @data_list = @_; + + my $sum_x = 0; + #Not using mean for computation saving. + my $sum_squares = 0; + #Using the standard computational formula for variance ( sum(x^2) - (sum(x))^2)/(n-1) + foreach (@data_list) { + $sum_x=$sum_x + $_; + $sum_squares = $sum_squares + ($_)*($_); + } + + my $n = @data_list; + return( sqrt( ($sum_squares - $sum_x*$sum_x/$n)/($n - 1 ) ) ); + +} + + ########################################## 1; diff --git a/macros/parserFormulaUpToConstant.pl b/macros/parserFormulaUpToConstant.pl index 3713391..996c5e5 100644 --- a/macros/parserFormulaUpToConstant.pl +++ b/macros/parserFormulaUpToConstant.pl @@ -22,11 +22,11 @@ =head1 DESCRIPTION This file implements the FormulaUpToConstant object, which is a formula that is only unique up to a constant (i.e., this is -an anti-derivative). Students must include the "+C" as part of +an anti-derivative). Students must include the "+C" as part of their answers, but they can use any (single-letter) constant that they want, and it doesn't have to be the one the professor used. -To use FormulaWithConstat objects, load this macro file at the +To use FormulaUpToConstant objects, load this macro file at the top of your problem: loadMacros("parserFormulaUpToConstant.pl"); @@ -64,7 +64,7 @@ =head1 DESCRIPTION To get the name of the constant in use in the formula, use - $f->constant. + $f->constant If you combine a FormulaUpToConstant with other formulas, the result will be a new FormulaUpToConstant object, with @@ -139,7 +139,7 @@ sub new { unless $n->isConstant; # # Make a version with adaptive parameters for use in the - # comparison later on. We could like n00*C, but already have $n + # comparison later on. We would like n00*C, but already have $n # copies of C, so remove them. That way, n00 will be 0 when there # are no C's in the student answer during the adaptive comparison. # (Again, should really check that n00 is not in use already) @@ -338,7 +338,7 @@ sub D { ###################################################################### # -# This class repalces the Parser::Variable class, and its job +# This class replaces the Parser::Variable class, and its job # is to look for new constants that aren't in the context, # and add them in. This allows students to use ANY constant # they want, and a different one from the professor. We check diff --git a/macros/parserMultiAnswer.pl b/macros/parserMultiAnswer.pl index e6c80f0..ae85dd0 100644 --- a/macros/parserMultiAnswer.pl +++ b/macros/parserMultiAnswer.pl @@ -105,7 +105,8 @@ package MultiAnswer; our @ISA = qw(Value); our $count = 0; # counter for unique identifier for multi-parts -our $answerPrefix = $main::PG->{QUIZ_PREFIX}."_MuLtIaNsWeR"; # answer rule prefix +our $answerPrefix = "_MuLtIaNsWeR"; # answer rule prefix +$answerPrefix = $main::PG->{QUIZ_PREFIX}."_MuLtIaNsWeR" if $main::PG->{QUIZ_PREFIX}; our $separator = ';'; # separator for singleResult previews =head1 CONSTRUCTOR diff --git a/macros/unionTables.pl b/macros/unionTables.pl index 5fcfef3..eca2a3e 100644 --- a/macros/unionTables.pl +++ b/macros/unionTables.pl @@ -35,17 +35,26 @@ =head2 unionTables.pl # valign => type set the vertical alignment # (default is "MIDDLE") # + # bhtml => string set HTML preamble for table + # (default is empty string "") + # + # ehtml => string set HTML postamble for table + # (default is empty string "") + # =cut sub ColumnTable { my $col1 = shift; my $col2 = shift; - my %options = (indent => 0, separation => 50, valign => "MIDDLE", @_); - my ($ind,$sep) = ($options{"indent"},$options{"separation"}); + my %options = ( + indent => 0, separation => 50, valign => "MIDDLE", + bhtml=>"", ehtml=>"", @_ + ); + my ($ind,$sep) = ($options{"indent"}, $options{"separation"}); my $valign = $options{"valign"}; my ($bhtml,$ehtml) = ('\begin{rawhtml}','\end{rawhtml}'); - ($bhtml,$ehtml) = ('','') unless ($displayMode eq "Latex2HTML"); + ($bhtml,$ehtml) = ($options{"bhtml"}, $options{"bhtml"}) unless ($displayMode eq "Latex2HTML"); my $HTMLtable = qq { $bhtml @@ -100,15 +109,22 @@ sub ColumnMatchTable { # (e.g, tex_spacing => 2em) (default 1em) # tex_border => dimen value for left- and right border in TeX (0pt) # center => 0 or 1 center table or not (default 1) + # bHTML => string set HTML preamble for table (default is empty string "") + # eHTML => string set HTML postamble for table (default is empty string "") + # # =cut sub BeginTable { - my %options = (border => 0, padding => 0, spacing => 0, center => 1, - tex_spacing => "1em", tex_border => "0pt", @_); + my %options = ( + border => 0, padding => 0, spacing => 0, center => 1, + tex_spacing => "1em", tex_border => "0pt", + bHTML=> ' ', eHTML=> ' ', @_ + ); my ($bd,$pd,$sp) = ($options{border},$options{padding},$options{spacing}); my ($tsp,$tbd) = ($options{tex_spacing},$options{tex_border}); + my ($bHTML, $eHTML) = ($options{bHTML}, $options{eHTML}); my ($center,$tcenter) = (' ALIGN="CENTER"','\centerline'); ($center,$tcenter) = ('','') if (!$options{center}); my $table = @@ -130,13 +146,19 @@ sub BeginTable { # where options are taken from: # # tex_border => dimen extra vertical space in TeX mode (default 0pt) + # bHTML => string set HTML preamble for table (default is empty string "") + # eHTML => string set HTML postamble for table (default is empty string "") # =cut sub EndTable { - my %options = (tex_border => "0pt", @_); + my %options = ( + tex_border => "0pt", + bHTML=> ' ', eHTML=> ' ', @_ + ); my $tbd = $options{tex_border}; + my ($bHTML, $eHTML) = ($options{bHTML}, $options{eHTML}); MODES( TeX => '\cr}}\kern '.$tbd.'}\medskip'."\n", Latex2HTML => $bHTML.'
'.$eHTML."\n", @@ -169,18 +191,27 @@ sub EndTable { # valign => "type" Specified vertical alignment of row # (default: valign => "MIDDLE") # + # bHTML => string set HTML preamble for table + # (default is empty string "") + # + # eHTML => string set HTML postamble for table + # (default is empty string "") + =cut sub Row { my $rowref = shift; my @row = @{$rowref}; + my %options = ( - indent => 0, separation => 30, - align => "LEFT", valign => "MIDDLE", - @_ - ); + indent => 0, separation => 30, + align => "LEFT", valign => "MIDDLE", + bHTML => ' ', eHTML => ' ', @_ + ); + my ($cind,$csep) = ($options{indent},$options{separation}); my ($align,$valign) = ($options{align},$options{valign}); + my ($bHTML, $eHTML) = ($options{bHTML}, $options{eHTML}); my $sep = ' '; $sep = '' if ($csep < 1); my $ind = ' '; $ind = '' if ($cind < 1); my $fill = ''; @@ -193,8 +224,7 @@ sub Row { TeX => '\cr'.$vspace."\n". $fill . join('& ',@row), Latex2HTML => $bHTML."$ind".$eHTML . - join($bHTML."$sep".$eHTML,@row) . - $bHTML.''.$eHTML."\n", + join($bHTML."$sep".$eHTML,@row) . $bHTML.''.$eHTML."\n", HTML => "$ind" . join("$sep",@row) . ''."\n" ); @@ -221,20 +251,30 @@ sub Row { # valign => "type" Specified vertical alignment of row # (default: valign => "MIDDLE") # + # bHTML => string Set HTML preamble for table + # (default is empty string "") + # + # eHTML => string Set HTML postamble for table + # (default is empty string "") + =cut sub AlignedRow { my $rowref = shift; my @row = @{$rowref}; my %options = ( - indent => 0, separation => 30, - align => "CENTER", valign => "MIDDLE", - @_ - ); + indent => 0, separation => 30, + align => "CENTER", valign => "MIDDLE", + bHTML => ' ', eHTML => ' ', @_ + ); + my ($cind,$csep) = ($options{indent},$options{separation}); my ($align,$valign) = ($options{align},$options{valign}); - my $sep = ' '; $sep = '' if ($csep < 1); - my $ind = ' '; $ind = '' if ($cind < 1); + my ($bHTML, $eHTML) = ($options{bHTML}, $options{eHTML}); + my $sep = ' '."\n"; + $sep = '' if ($csep < 1); + my $ind = ' '."\n"; + $ind = '' if ($cind < 1); my $fill = ''; $fill = '\hfil ' if (uc($align) eq "CENTER"); $fill = '\hfill ' if (uc($align) eq "RIGHT"); @@ -244,11 +284,10 @@ sub AlignedRow { MODES( TeX => '\cr'.$vspace."\n". $fill . join('&'.$fill,@row), Latex2HTML => - $bHTML."$ind".$eHTML . - join($bHTML."$sep".$eHTML,@row) . - $bHTML.''.$eHTML."\n", - HTML => "$ind" . - join("$sep",@row) . ''."\n" + $bHTML."\n$ind". + join($bHTML."\n$sep".$eHTML,@row) . $bHTML."\n\n".$eHTML."\n", + HTML => "\n$ind\n" . + join("\n$sep", @row) . "\n\n", ); } @@ -273,8 +312,8 @@ sub TableSpace { MODES( TeX => '\vadjust{\kern '.$rsep.'pt}' . "\n", Latex2HTML => - $bHTML.''.$eHTML."\n", - HTML => ''."\n", + "\n\n\n", + HTML => "\n\n", ); } @@ -291,9 +330,7 @@ sub TableSpace { sub TableLine { MODES( TeX => '\vadjust{\kern2pt\hrule\kern2pt}', - Latex2HTML => $bHTML. - '
'. - $eHTML."\n", + Latex2HTML => '
'."\n", HTML =>'
'."\n" ); } From 8765f51cfaad8327a3e03b2911e4d4acbba9e840 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 6 Dec 2012 16:10:12 -0800 Subject: [PATCH 02/15] Initial commit for R-integration. This is work in progress and probably doesn't actually work at the moment. --- .gitmodules | 3 +++ lib/Rserve | 1 + lib/Rserve-perl | 1 + lib/Rserve.pm | 1 + macros/rserve.pl | 37 +++++++++++++++++++++++++++++++++++++ 5 files changed, 43 insertions(+) create mode 100644 .gitmodules create mode 120000 lib/Rserve create mode 160000 lib/Rserve-perl create mode 120000 lib/Rserve.pm create mode 100644 macros/rserve.pl diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..ee928f5 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "lib/Rserve-perl"] + path = lib/Rserve-perl + url = git://github.com/djun-kim/Rserve-perl.git diff --git a/lib/Rserve b/lib/Rserve new file mode 120000 index 0000000..ea7267b --- /dev/null +++ b/lib/Rserve @@ -0,0 +1 @@ +Rserve-perl/Rserve \ No newline at end of file diff --git a/lib/Rserve-perl b/lib/Rserve-perl new file mode 160000 index 0000000..f957158 --- /dev/null +++ b/lib/Rserve-perl @@ -0,0 +1 @@ +Subproject commit f957158a2170d97f8bb5405e325b0aa178934627 diff --git a/lib/Rserve.pm b/lib/Rserve.pm new file mode 120000 index 0000000..07e8b0f --- /dev/null +++ b/lib/Rserve.pm @@ -0,0 +1 @@ +Rserve-perl/Rserve.pm \ No newline at end of file diff --git a/macros/rserve.pl b/macros/rserve.pl new file mode 100644 index 0000000..b0441ab --- /dev/null +++ b/macros/rserve.pl @@ -0,0 +1,37 @@ +use Rserve::Connection; +#use strict; +#use warnings; + +# Rserve connection +my $cnx; + +sub _rserve_init {}; + +#sub rserve_start { +# $cnx = Rserve::Connection->new('localhost'); +#} + +#sub rserve_finish { +# if (ref($cnx)=="Rserve::Connection") { +# $cnx->close(); +# } +#} + +#sub rserve_eval { +# my $query = shift; +# my @res = $cnx->evalString($query); +# return @res; +#} + +#sub rserve_query { +# my $query = shift; +# my $rserve_client = Rserve::Connection->new('localhost'); +# my @res = $rserve_client->evalString($query); +# #print ("result = $res"); +# return @res; +#} + +#sub rserve_plot_png { +#} + +1; From fdbf83ba11ee6a16cdc3bbbd7171cb95d1c492ab Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Sun, 9 Dec 2012 09:46:27 -0800 Subject: [PATCH 03/15] Added debug() statements. Remove rserve.pl from @unrestricted_files list (not needed?). Fixup spacing. --- lib/WeBWorK/PG/Translator.pm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index 4004b0c..9ca0994 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -11,6 +11,7 @@ use Opcode; use WWSafe; use Net::SMTP; use WeBWorK::PG::IO; +use WeBWorK::Debug; #use PadWalker; # used for processing error messages #use Data::Dumper; @@ -155,7 +156,14 @@ sub load_extra_packages{ sub new { my $class = shift; + + debug("Creating new translator."); + my $safe_cmpt = new WWSafe; #('PG_priv'); + + debug("Created new safe compartment."); + debug("Safe: " . $safe_cmpt->{Root}); + my $self = { preprocess_code => \&default_preprocess_code, postprocess_code => \&default_postprocess_code, @@ -396,7 +404,9 @@ sub pre_load_macro_files { # all other files are loaded with restriction # # construct a regex that matches only these three files safely - my @unrestricted_files = (); # no longer needed? FIXME w/PG.pl IO.pl/; + + # no longer needed? FIXME w/PG.pl IO.pl/; + my @unrestricted_files = qw(); my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files); my $store_mask; @@ -531,7 +541,6 @@ sub source_file { } - sub unrestricted_load { my $self = shift; my $filePath = shift; @@ -551,7 +560,7 @@ sub unrestricted_load { my $init_subroutine = eval { \&{$init_subroutine_name} }; warn "No init routine for $init_subroutine_name: $@" if $debugON and $@; use strict; - my $macro_file_loaded = ref($init_subroutine) =~ /CODE/; + my $macro_file_loaded = ref($init_subroutine) =~ /CODE/; #print STDERR "$macro_file_name has not yet been loaded\n" unless $macro_file_loaded; unless ($macro_file_loaded) { From f55ca8666aab4275d6d841ed64f6afae5f448db7 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Sun, 9 Dec 2012 09:47:08 -0800 Subject: [PATCH 04/15] Fix file permissions for three macro files. --- macros/CanvasObject.pl | 0 macros/contextTypeset.pl | 0 macros/parserQuotedString.pl | 0 3 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 macros/CanvasObject.pl mode change 100755 => 100644 macros/contextTypeset.pl mode change 100755 => 100644 macros/parserQuotedString.pl diff --git a/macros/CanvasObject.pl b/macros/CanvasObject.pl old mode 100755 new mode 100644 diff --git a/macros/contextTypeset.pl b/macros/contextTypeset.pl old mode 100755 new mode 100644 diff --git a/macros/parserQuotedString.pl b/macros/parserQuotedString.pl old mode 100755 new mode 100644 From 16293cae47b46ca1162d35bdab7202d5a89f2d9c Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Mon, 10 Dec 2012 10:26:39 -0800 Subject: [PATCH 05/15] Improved connection handling and added support for dynamically generated R-plots --- lib/Rserve-perl | 2 +- macros/rserve.pl | 135 +++++++++++++++++++++++++++++++++++++---------- 2 files changed, 108 insertions(+), 29 deletions(-) diff --git a/lib/Rserve-perl b/lib/Rserve-perl index f957158..2539171 160000 --- a/lib/Rserve-perl +++ b/lib/Rserve-perl @@ -1 +1 @@ -Subproject commit f957158a2170d97f8bb5405e325b0aa178934627 +Subproject commit 253917142237e5cc680a80ee36df2aef5090314f diff --git a/macros/rserve.pl b/macros/rserve.pl index b0441ab..52d248f 100644 --- a/macros/rserve.pl +++ b/macros/rserve.pl @@ -1,3 +1,27 @@ +=head1 NAME + +rserve.pl - Macros for querying an Rserve server (see R-project.org) + +=head1 SYNPOSIS + +Example: generate a normally distributed vector of 15 elements, +with mean 1, standard deviation 2, rounded to 4 decimal places. + + $m = 1; + $sd = 2; + @rnorm = rserve_query(EV2(<new('localhost'); -#} - -#sub rserve_finish { -# if (ref($cnx)=="Rserve::Connection") { -# $cnx->close(); -# } -#} - -#sub rserve_eval { -# my $query = shift; -# my @res = $cnx->evalString($query); -# return @res; -#} - -#sub rserve_query { -# my $query = shift; -# my $rserve_client = Rserve::Connection->new('localhost'); -# my @res = $rserve_client->evalString($query); -# #print ("result = $res"); -# return @res; -#} - -#sub rserve_plot_png { -#} +sub _rserve_init { +}; + +sub rserve_start { + if (!defined $cnx or ref($cnx) != "Rserve::Connection") { + $cnx = Rserve::Connection->new('localhost'); + } + + # Ensure R's random number generation is given a well-defined seed. + # $problemSeed is the environmental variable defined by WeBWorK which + # gives the random seed associated to a given problem/user assignment. + + my $query = "set.seed($problemSeed)\n"; + $cnx->evalString($query); +} + +sub rserve_finish { + if (ref($cnx)=="Rserve::Connection") { + $cnx->close(); + } +} + +sub rserve_eval { + my $query = shift; + + if (ref($cnx) != "Rserve::Connection") { + $cnx = Rserve::Connection->new('localhost'); + } + my @res = $cnx->evalString($query); + return @res; +} + + +sub rserve_query { + my $query = shift; + $query = "set.seed($problemSeed)\n" . $query; + my $rserve_client = Rserve::Connection->new('localhost'); + my @res = $rserve_client->evalString($query); + #print ("result = $res"); + return @res; +} + +sub rserve_start_plot ($) { + my $imgtype = shift; + my $rand = sprintf("%05d", random(0, 99999, 1)); + + my $filename = "tmpfile".$rand; + + if ($imgtype == 'png') { + $suffix = ".png"; + $filename .= $suffix; + rserve_eval("png(filename='/tmp/$filename')"); + } + elsif ($imgtype = 'jpg') { + $suffix = ".jpg"; + $filename .= $suffix; + rserve_eval("jpeg(filename='/tmp/$filename')"); + } + elsif ($imgtype = 'pdf') { + $suffix = ".pdf"; + $filename .= $suffix; + rserve_eval("pdf(filename='/tmp/$filename')"); + } + else { + warn "unknown/unsupported image type '$imgtype'\n"; + } + + return $filename; +} + +sub rserve_finish_plot ($) { + my $file = shift; + my $filename = $tempDirectory . "/$file"; + + rserve_eval("dev.off()"); + @stream = rserve_eval("readBin('/tmp/$file', what='raw', n=1e6)"); + + open BINARY, ">:raw", $filename; + foreach (@stream) { print BINARY $_} + close BINARY; + + return $filename; +} 1; From e15dc72d2ea7c26ddd3f3ad2d17d08044b314302 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 13 Dec 2012 11:46:27 -0800 Subject: [PATCH 06/15] * Use proper testing for non-numeric equalities. * Use R to generate temporary file names on R server (using tempfile() function). * Don't "use" Rserve::Connection; instead preload modules into Safe compartment using configuration in defaults.config. * Move creation of image file into Rserve module (function evalStringToFile()). --- macros/rserve.pl | 62 +++++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/macros/rserve.pl b/macros/rserve.pl index 52d248f..cc4bb0f 100644 --- a/macros/rserve.pl +++ b/macros/rserve.pl @@ -22,7 +22,10 @@ =head1 DESCRIPTION =cut -use Rserve::Connection; +# This uses Rserve::Connection, but to play nicely with the Safe compartment, we load the module +# and all of its dependencies by specifying them in the modules configuration of defaults.config. +# Hence the following line is commented out. +# Rserve::Connection; #use strict; #use warnings; @@ -33,20 +36,18 @@ sub _rserve_init { }; sub rserve_start { - if (!defined $cnx or ref($cnx) != "Rserve::Connection") { + if (!defined $cnx or ref($cnx) ne "Rserve::Connection") { $cnx = Rserve::Connection->new('localhost'); } # Ensure R's random number generation is given a well-defined seed. # $problemSeed is the environmental variable defined by WeBWorK which # gives the random seed associated to a given problem/user assignment. - - my $query = "set.seed($problemSeed)\n"; - $cnx->evalString($query); + $cnx->evalString("set.seed($problemSeed)"); } sub rserve_finish { - if (ref($cnx)=="Rserve::Connection") { + if (ref($cnx) eq "Rserve::Connection") { $cnx->close(); } } @@ -54,7 +55,7 @@ sub rserve_finish { sub rserve_eval { my $query = shift; - if (ref($cnx) != "Rserve::Connection") { + if (ref($cnx) ne "Rserve::Connection") { $cnx = Rserve::Connection->new('localhost'); } my @res = $cnx->evalString($query); @@ -73,44 +74,45 @@ sub rserve_query { sub rserve_start_plot ($) { my $imgtype = shift; - my $rand = sprintf("%05d", random(0, 99999, 1)); - my $filename = "tmpfile".$rand; + my $filename = ""; - if ($imgtype == 'png') { - $suffix = ".png"; - $filename .= $suffix; - rserve_eval("png(filename='/tmp/$filename')"); + if ($imgtype eq 'png') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".png" )'); + $filename = $filename_ref[0]; + rserve_eval("png(filename='$filename')"); } - elsif ($imgtype = 'jpg') { - $suffix = ".jpg"; - $filename .= $suffix; - rserve_eval("jpeg(filename='/tmp/$filename')"); + elsif ($imgtype eq 'jpg') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".jpg" )'); + $filename = $filename_ref[0]; + rserve_eval("jpeg(filename='$filename')"); } - elsif ($imgtype = 'pdf') { - $suffix = ".pdf"; - $filename .= $suffix; - rserve_eval("pdf(filename='/tmp/$filename')"); + elsif ($imgtype eq 'pdf') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".pdf" )'); + $filename = $filename_ref[0]; + rserve_eval("pdf(filename='$filename')"); } else { warn "unknown/unsupported image type '$imgtype'\n"; } - return $filename; } sub rserve_finish_plot ($) { - my $file = shift; - my $filename = $tempDirectory . "/$file"; + my $filepath = shift; + + @pathcomponents = split "/", $filepath; + $file = $pathcomponents[@pathcomponents-1]; + + my $imgfile = $tempDirectory . $file; rserve_eval("dev.off()"); - @stream = rserve_eval("readBin('/tmp/$file', what='raw', n=1e6)"); - open BINARY, ">:raw", $filename; - foreach (@stream) { print BINARY $_} - close BINARY; - - return $filename; + # $tempDirectory is a WeBWorK "environmental variable"; + $cnx-> evalStringToFile("readBin('$filepath', what='raw', n=1e6)", $imgfile); + + + return $imgfile; } 1; From 733260abaefc7a99af960e2572a4ae33ce0279a0 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 13 Dec 2012 11:47:56 -0800 Subject: [PATCH 07/15] Added some debugging; fixed minor typo --- lib/WeBWorK/PG/Translator.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index 9ca0994..c7518a6 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -101,7 +101,7 @@ sub evaluate_modules { my @modules = @_; local $SIG{__DIE__} = "DEFAULT"; # we're going to be eval()ing code foreach (@modules) { - #warn "attempting to load $_\n"; + # debug "attempting to load $_\n"; # ensure that the name is in fact a base name s/\.pm$// and warn "fixing your broken package name: $_.pm => $_"; # call runtime_use on the package name @@ -128,7 +128,7 @@ sub evaluate_modules { Loads extra packages for modules that contain more than one package. Works in conjunction with evaluate_modules. It is assumed that the file containing the extra packages (along with the base -pachage name which is the same as the name of the file minus the .pm extension) has already been +package name which is the same as the name of the file minus the .pm extension) has already been loaded using evaluate_modules =cut From 75e3d86c6cabcc9cd48f9275c81d1d488632385b Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 13 Dec 2012 15:29:52 -0800 Subject: [PATCH 08/15] Update Rserve-perl --- lib/Rserve-perl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Rserve-perl b/lib/Rserve-perl index 2539171..70515ff 160000 --- a/lib/Rserve-perl +++ b/lib/Rserve-perl @@ -1 +1 @@ -Subproject commit 253917142237e5cc680a80ee36df2aef5090314f +Subproject commit 70515ff92dcda83427b0a88d6ae5883fb0462c06 From 130b0a8d54aaeed8ad059b0da32b2b8fb6572d17 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Tue, 8 Jan 2013 15:45:09 -0800 Subject: [PATCH 09/15] Remove Rserve-perl submodule (has been repackaged as CPAN module) --- lib/Rserve-perl | 1 - 1 file changed, 1 deletion(-) delete mode 160000 lib/Rserve-perl diff --git a/lib/Rserve-perl b/lib/Rserve-perl deleted file mode 160000 index 70515ff..0000000 --- a/lib/Rserve-perl +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 70515ff92dcda83427b0a88d6ae5883fb0462c06 From 765411641381b7da1b7620fe8ab46b66cc584f30 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Tue, 8 Jan 2013 15:45:26 -0800 Subject: [PATCH 10/15] Remove Rserve-perl submodule (has been repackaged as CPAN module) --- .gitmodules | 3 --- 1 file changed, 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index ee928f5..e69de29 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +0,0 @@ -[submodule "lib/Rserve-perl"] - path = lib/Rserve-perl - url = git://github.com/djun-kim/Rserve-perl.git From bfedd21dc4c2b1be87ead3f661b3fe59496a5726 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Tue, 8 Jan 2013 15:51:03 -0800 Subject: [PATCH 11/15] Renamed rserve.pl to RserveClient.pl; updated documentation --- macros/RserveClient.pl | 123 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 123 insertions(+) create mode 100644 macros/RserveClient.pl diff --git a/macros/RserveClient.pl b/macros/RserveClient.pl new file mode 100644 index 0000000..67d1fa7 --- /dev/null +++ b/macros/RserveClient.pl @@ -0,0 +1,123 @@ +=head1 NAME + +RserveClient.pl - Macros for querying an Rserve server (see R-project.org) + +=head1 SYNPOSIS + +Example: generate a normally distributed vector of 15 elements, +with mean 1, standard deviation 2, rounded to 4 decimal places. + + $m = 1; + $sd = 2; + @rnorm = rserve_query(EV2(<new('localhost'); + } + + # Ensure R's random number generation is given a well-defined seed. + # $problemSeed is the environmental variable defined by WeBWorK which + # gives the random seed associated to a given problem/user assignment. + $cnx->evalString("set.seed($problemSeed)"); +} + +sub rserve_finish { + if (ref($cnx) eq "Rserve::Connection") { + $cnx->close(); + } +} + +sub rserve_eval { + my $query = shift; + + if (ref($cnx) ne "Rserve::Connection") { + $cnx = Rserve::Connection->new('localhost'); + } + my @res = $cnx->evalString($query); + return @res; +} + + +sub rserve_query { + my $query = shift; + $query = "set.seed($problemSeed)\n" . $query; + my $rserve_client = Rserve::Connection->new('localhost'); + my @res = $rserve_client->evalString($query); + #print ("result = $res"); + return @res; +} + +sub rserve_start_plot ($) { + my $imgtype = shift; + + my $filename = ""; + + if ($imgtype eq 'png') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".png" )'); + $filename = $filename_ref[0]; + rserve_eval("png(filename='$filename')"); + } + elsif ($imgtype eq 'jpg') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".jpg" )'); + $filename = $filename_ref[0]; + rserve_eval("jpeg(filename='$filename')"); + } + elsif ($imgtype eq 'pdf') { + @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".pdf" )'); + $filename = $filename_ref[0]; + rserve_eval("pdf(filename='$filename')"); + } + else { + warn "unknown/unsupported image type '$imgtype'\n"; + } + return $filename; +} + +sub rserve_finish_plot ($) { + my $filepath = shift; + + @pathcomponents = split "/", $filepath; + $file = $pathcomponents[@pathcomponents-1]; + + my $imgfile = $tempDirectory . $file; + + rserve_eval("dev.off()"); + + # $tempDirectory is a WeBWorK "environmental variable"; + $cnx-> evalStringToFile("readBin('$filepath', what='raw', n=1e6)", $imgfile); + + + return $imgfile; +} + +1; From 1a55496092933d361e13a8d38ba29e474681e2da Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Tue, 8 Jan 2013 15:51:47 -0800 Subject: [PATCH 12/15] Renamed rserve.pl to RserveClient.pl; updated documentation --- macros/rserve.pl | 118 ----------------------------------------------- 1 file changed, 118 deletions(-) delete mode 100644 macros/rserve.pl diff --git a/macros/rserve.pl b/macros/rserve.pl deleted file mode 100644 index cc4bb0f..0000000 --- a/macros/rserve.pl +++ /dev/null @@ -1,118 +0,0 @@ -=head1 NAME - -rserve.pl - Macros for querying an Rserve server (see R-project.org) - -=head1 SYNPOSIS - -Example: generate a normally distributed vector of 15 elements, -with mean 1, standard deviation 2, rounded to 4 decimal places. - - $m = 1; - $sd = 2; - @rnorm = rserve_query(EV2(<new('localhost'); - } - - # Ensure R's random number generation is given a well-defined seed. - # $problemSeed is the environmental variable defined by WeBWorK which - # gives the random seed associated to a given problem/user assignment. - $cnx->evalString("set.seed($problemSeed)"); -} - -sub rserve_finish { - if (ref($cnx) eq "Rserve::Connection") { - $cnx->close(); - } -} - -sub rserve_eval { - my $query = shift; - - if (ref($cnx) ne "Rserve::Connection") { - $cnx = Rserve::Connection->new('localhost'); - } - my @res = $cnx->evalString($query); - return @res; -} - - -sub rserve_query { - my $query = shift; - $query = "set.seed($problemSeed)\n" . $query; - my $rserve_client = Rserve::Connection->new('localhost'); - my @res = $rserve_client->evalString($query); - #print ("result = $res"); - return @res; -} - -sub rserve_start_plot ($) { - my $imgtype = shift; - - my $filename = ""; - - if ($imgtype eq 'png') { - @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".png" )'); - $filename = $filename_ref[0]; - rserve_eval("png(filename='$filename')"); - } - elsif ($imgtype eq 'jpg') { - @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".jpg" )'); - $filename = $filename_ref[0]; - rserve_eval("jpeg(filename='$filename')"); - } - elsif ($imgtype eq 'pdf') { - @filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".pdf" )'); - $filename = $filename_ref[0]; - rserve_eval("pdf(filename='$filename')"); - } - else { - warn "unknown/unsupported image type '$imgtype'\n"; - } - return $filename; -} - -sub rserve_finish_plot ($) { - my $filepath = shift; - - @pathcomponents = split "/", $filepath; - $file = $pathcomponents[@pathcomponents-1]; - - my $imgfile = $tempDirectory . $file; - - rserve_eval("dev.off()"); - - # $tempDirectory is a WeBWorK "environmental variable"; - $cnx-> evalStringToFile("readBin('$filepath', what='raw', n=1e6)", $imgfile); - - - return $imgfile; -} - -1; From 181feced29e61c6e45a154cecab0e3cfe000bd48 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Wed, 9 Jan 2013 11:28:52 -0800 Subject: [PATCH 13/15] Update RserveClient to API changes for Statistics::RserveClient --- macros/RserveClient.pl | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/macros/RserveClient.pl b/macros/RserveClient.pl index 67d1fa7..ef90fa9 100644 --- a/macros/RserveClient.pl +++ b/macros/RserveClient.pl @@ -34,15 +34,15 @@ =head1 DESCRIPTION #use strict; #use warnings; -# Rserve connection +# RserveClient connection my $cnx; sub _rserve_init { }; sub rserve_start { - if (!defined $cnx or ref($cnx) ne "Rserve::Connection") { - $cnx = Rserve::Connection->new('localhost'); + if (!defined $cnx or ref($cnx) ne "Statistics::RserveClient::Connection") { + $cnx = Statistics::RserveClient::Connection->new('localhost'); } # Ensure R's random number generation is given a well-defined seed. @@ -52,16 +52,16 @@ sub rserve_start { } sub rserve_finish { - if (ref($cnx) eq "Rserve::Connection") { - $cnx->close(); + if (ref($cnx) eq "Statistics::RserveClient::Connection") { + $cnx->close_connection(); } } sub rserve_eval { my $query = shift; - if (ref($cnx) ne "Rserve::Connection") { - $cnx = Rserve::Connection->new('localhost'); + if (ref($cnx) ne "Statistics::RserveClient::Connection") { + $cnx = Statistics::RserveClient::Connection->new('localhost'); } my @res = $cnx->evalString($query); return @res; @@ -71,7 +71,7 @@ sub rserve_eval { sub rserve_query { my $query = shift; $query = "set.seed($problemSeed)\n" . $query; - my $rserve_client = Rserve::Connection->new('localhost'); + my $rserve_client = Statistics::RserveClient::Connection->new('localhost'); my @res = $rserve_client->evalString($query); #print ("result = $res"); return @res; From 84c05c31cd9b92e59c8b665abf8e26cf01aa660e Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Wed, 6 Feb 2013 23:44:36 -0800 Subject: [PATCH 14/15] Remove unneeded Symbolic Links --- lib/Rserve | 1 - lib/Rserve.pm | 1 - 2 files changed, 2 deletions(-) delete mode 120000 lib/Rserve delete mode 120000 lib/Rserve.pm diff --git a/lib/Rserve b/lib/Rserve deleted file mode 120000 index ea7267b..0000000 --- a/lib/Rserve +++ /dev/null @@ -1 +0,0 @@ -Rserve-perl/Rserve \ No newline at end of file diff --git a/lib/Rserve.pm b/lib/Rserve.pm deleted file mode 120000 index 07e8b0f..0000000 --- a/lib/Rserve.pm +++ /dev/null @@ -1 +0,0 @@ -Rserve-perl/Rserve.pm \ No newline at end of file From 900a40a770831ac47d23338aea551ad422d91205 Mon Sep 17 00:00:00 2001 From: Djun Kim Date: Thu, 7 Feb 2013 14:04:22 -0800 Subject: [PATCH 15/15] Remove un-needed files. --- lib/Rserve | 1 - lib/Rserve-perl | 1 - lib/Rserve.pm | 1 - 3 files changed, 3 deletions(-) delete mode 120000 lib/Rserve delete mode 160000 lib/Rserve-perl delete mode 120000 lib/Rserve.pm diff --git a/lib/Rserve b/lib/Rserve deleted file mode 120000 index ea7267b..0000000 --- a/lib/Rserve +++ /dev/null @@ -1 +0,0 @@ -Rserve-perl/Rserve \ No newline at end of file diff --git a/lib/Rserve-perl b/lib/Rserve-perl deleted file mode 160000 index f957158..0000000 --- a/lib/Rserve-perl +++ /dev/null @@ -1 +0,0 @@ -Subproject commit f957158a2170d97f8bb5405e325b0aa178934627 diff --git a/lib/Rserve.pm b/lib/Rserve.pm deleted file mode 120000 index 07e8b0f..0000000 --- a/lib/Rserve.pm +++ /dev/null @@ -1 +0,0 @@ -Rserve-perl/Rserve.pm \ No newline at end of file