[LON-CAPA-cvs] cvs: loncom /build/system_dependencies cpan_distributions.txt /homework constants.json loncapamath.pm lonhomework.pm units.json /homework/math_parser CalcEnv.pm CalcException.pm Definitions.pm ENode.pm Operator.pm ParseException.pm Parser.pm QInterval.pm QIntervalUnion.pm QMatrix.pm QSet.pm QVector.pm Quantity.pm Token.pm Tokenizer.pm Units.pm doc/loncapafiles loncapafiles.lpml
damieng
damieng at source.lon-capa.org
Mon Jun 29 11:42:13 EDT 2015
damieng Mon Jun 29 15:42:13 2015 EDT
Added files:
/loncom/homework constants.json loncapamath.pm units.json
/loncom/homework/math_parser CalcEnv.pm CalcException.pm
Definitions.pm ENode.pm Operator.pm
ParseException.pm Parser.pm
QInterval.pm QIntervalUnion.pm
QMatrix.pm QSet.pm QVector.pm
Quantity.pm Token.pm Tokenizer.pm
Units.pm
Modified files:
/doc/loncapafiles loncapafiles.lpml
/loncom/build/system_dependencies cpan_distributions.txt
/loncom/homework lonhomework.pm
Log:
added implementation for <lm>
-------------- next part --------------
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.920 doc/loncapafiles/loncapafiles.lpml:1.921
--- doc/loncapafiles/loncapafiles.lpml:1.920 Thu Jun 18 20:18:41 2015
+++ doc/loncapafiles/loncapafiles.lpml Mon Jun 29 15:41:56 2015
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.920 2015/06/18 20:18:41 musolffc Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.921 2015/06/29 15:41:56 damieng Exp $ -->
<!--
@@ -455,6 +455,12 @@
</directory>
<directory dist='default'>
<protectionlevel>modest_delete</protectionlevel>
+ <targetdir dist='default'>home/httpd/lib/perl/Apache/math_parser</targetdir>
+ <categoryname>server readonly</categoryname>
+ <description>location of LON-CAPA math parser</description>
+</directory>
+<directory dist='default'>
+ <protectionlevel>modest_delete</protectionlevel>
<targetdir dist='default'>home/httpd/lib/perl/HTML</targetdir>
<categoryname>server readonly</categoryname>
<description>location of HTML specific perl module fixes and additions
@@ -6154,6 +6160,177 @@
<status>works/unverified</status>
</file>
<file>
+ <source>loncom/homework/loncapamath.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/loncapamath.pm</target>
+ <categoryname>handler</categoryname>
+ <description>
+ lm element implementation, using the math parser package
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/units.json</source>
+ <target dist='default'>home/httpd/lonTabs/units.json</target>
+ <categoryname>static conf</categoryname>
+ <description>
+ Math parser: units
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/constants.json</source>
+ <target dist='default'>home/httpd/lonTabs/constants.json</target>
+ <categoryname>static conf</categoryname>
+ <description>
+ Math parser: constants
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/CalcEnv.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/CalcEnv.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Calculation environment
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/CalcException.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/CalcException.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Calculation exception
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Definitions.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Definitions.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Operator definitions
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/ENode.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/ENode.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Parsed tree node.
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Operator.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Operator.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Parser operator
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/ParseException.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/ParseException.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Parse exception
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Parser.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Parser.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Equation parser
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/QInterval.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/QInterval.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: An interval of quantities
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/QIntervalUnion.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/QIntervalUnion.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A union of possibly disjoint intervals
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/QMatrix.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/QMatrix.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A matrix of quantities
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/QSet.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/QSet.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A set of quantities
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Quantity.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Quantity.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A quantity (value and units)
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/QVector.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/QVector.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A vector of quantities
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Token.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Token.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: A parser token.
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Tokenizer.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Tokenizer.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: String tokenizer
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
+ <source>loncom/homework/math_parser/Units.pm</source>
+ <target dist='default'>home/httpd/lib/perl/Apache/math_parser/Units.pm</target>
+ <categoryname>system file</categoryname>
+ <description>
+ Math parser: Loads and converts units
+ </description>
+ <status>works/unverified</status>
+</file>
+<file>
<source>loncom/xml/Safe.pm</source>
<target dist='default'>home/httpd/lib/perl/Safe.pm</target>
<categoryname>handler</categoryname>
Index: loncom/build/system_dependencies/cpan_distributions.txt
diff -u loncom/build/system_dependencies/cpan_distributions.txt:1.13 loncom/build/system_dependencies/cpan_distributions.txt:1.14
--- loncom/build/system_dependencies/cpan_distributions.txt:1.13 Thu Feb 17 09:00:26 2005
+++ loncom/build/system_dependencies/cpan_distributions.txt Mon Jun 29 15:42:02 2015
@@ -1,7 +1,7 @@
# cpan_distributions.txt - This controls what CPAN packages are part of the
# LON-CAPA system.
-# $Id: cpan_distributions.txt,v 1.13 2005/02/17 09:00:26 albertel Exp $
+# $Id: cpan_distributions.txt,v 1.14 2015/06/29 15:42:02 damieng Exp $
# Field arrangement: DistName, DevVersion, StableVersion, VersionFrom
# Field definitions:
@@ -27,12 +27,15 @@
# version.
Algorithm-Diff 1.15 1.11a Algorithm::Diff(*)
+aliased 0.34 0.34 aliased(*)
Authen-PAM 0.14 0.14 Authen::PAM(*)
Crypt-DES 2.03 2.03 Crypt::DES(*)
Crypt-IDEA 1.01 1.01 Crypt::IDEA(*)
DBI 1.30 1.20 DBI(*)
Digest-MD5 2.24 2.24 Digest::MD5(*)
+enum 1.016 1.016 enum(*)
Event 0.87 0.87 Event(*)
+File-Slurp 9999.19 9999.19 File::Slurp(*)
GD 2.07 2.07 GD(*)
GD-Barcode 1.14 1.14 GD::Barcode(*)
GDGraph 1.40 1.40 GD::Graph(*)
@@ -44,6 +47,7 @@
I18N-LangTags 0.27 0.27 I18N::LangTags(*)
IO 1.20 1.20 IO(*)
IO-stringy 2.108 2.108 IO::Stringy(*)
+JSON-DWIW 0.47 0.47 JSON::DWIW(*)
Krb4 1.1 1.1 Authen::Krb4(*)
Krb5 1.2 1.2 Authen::Krb5(*)
libnet 1.12 1.0704 Net::FTP(2.65,2.58)
@@ -69,3 +73,4 @@
Text-Query-Advanced 0.05 0.05 Text::Query::Advanced(*)
Text-Query-Simple 0.03 0.03 Text::Query::Simple(*)
Time-HiRes 1.48 1.48 Time::HiRes(*)
+Try-Tiny 0.22 0.22 Try::Tiny(*)
Index: loncom/homework/lonhomework.pm
diff -u loncom/homework/lonhomework.pm:1.354 loncom/homework/lonhomework.pm:1.355
--- loncom/homework/lonhomework.pm:1.354 Wed Jun 17 03:57:01 2015
+++ loncom/homework/lonhomework.pm Mon Jun 29 15:42:07 2015
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# The LON-CAPA Homework handler
#
-# $Id: lonhomework.pm,v 1.354 2015/06/17 03:57:01 musolffc Exp $
+# $Id: lonhomework.pm,v 1.355 2015/06/29 15:42:07 damieng Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,6 +49,7 @@
use Apache::chemresponse();
use Apache::functionplotresponse();
use Apache::drawimage();
+use Apache::loncapamath();
use Apache::Constants qw(:common);
use Apache::loncommon();
use Apache::lonparmset();
Index: loncom/homework/constants.json
+++ loncom/homework/constants.json
{
"c": { "value": "299792458", "units": {"m":1,"s":-1} },
"pi": { "value": "3.14159265359", "units": {} },
"e": { "value": "2.71828182846", "units": {} },
"hbar": { "value": "1.05457148E-34", "units": {"m":2,"kg":1,"s":-1} },
"amu": { "value": "1.66053873E-27", "units": {"kg":1} },
"G": { "value": "6.67384E-11", "units": {"m":3,"kg":-1,"s":-2} }
}
Index: loncom/homework/loncapamath.pm
+++ loncom/homework/loncapamath.pm
# The LearningOnline Network with CAPA
# <lm>: math with the LON-CAPA syntax
#
# $Id: loncapamath.pm,v 1.1 2015/06/29 15:42:07 damieng Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::loncapamath;
use strict;
use warnings;
use utf8;
use Try::Tiny;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::ParseException';
use aliased 'Apache::math_parser::Parser';
use aliased 'Apache::math_parser::ENode';
use aliased 'Apache::math_parser::CalcEnv';
BEGIN {
&Apache::lonxml::register('Apache::loncapamath',('lm'));
}
sub start_lm {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_;
# Implementation note: this is using ENode::toTex, but we could also
# use a client-side implementation to display <lm>.
# While we use LaTeX for printing, turning the math into TeX for the web
# ensures that results will be more similar between web and print targets
# than they would be with a client-side implementation turning the
# parsed math directly into MathML.
$Apache::lonxml::post_evaluate = 0;
if ($target ne 'web' && $target ne 'tex') {
return;
}
my $text = &Apache::lonxml::get_all_text_unbalanced("/lm", $parser);
my $mode = &Apache::lonxml::get_param('mode',$parstack,$safeeval);
$text = &Apache::run::evaluate($text, $safeeval, $$parstack[-1]);
my $tex;
my $implicit_operators = 1;
my $unit_mode;
if (defined $mode && $mode eq 'units') {
$unit_mode = 1;
} else {
$unit_mode = 0;
}
my ($p, $root, $env);
my $result;
try {
$p = Parser->new($implicit_operators, $unit_mode);
$root = $p->parse($text);
$env = CalcEnv->new($unit_mode);
$tex = $root->toTeX();
} catch {
# NOTE: return cannot be used within a try/catch with Try::Tiny
if (UNIVERSAL::isa($_,CalcException)) {
$result = "Calculation error: ".$_->getLocalizedMessage();
} elsif (UNIVERSAL::isa($_,ParseException)) {
$result = "Parsing error: ".$_->getLocalizedMessage();
} else {
$result = "Internal error: $_";
}
};
if (defined $result) {
if ($target eq 'web') {
return '<b>'.$result.'</b>';
} elsif ($target eq 'tex') {
return '\bf{'.$result.'}';
}
}
if ($target eq 'web') {
my $display = &Apache::lonxml::get_param('display', $parstack, $safeeval);
$tex = '$'.$tex.'$';
$result = &Apache::lontexconvert::converted(\$tex, $display);
} elsif ($target eq 'tex') {
$result = '\ensuremath{'.$tex.'}';
}
return $result;
}
sub end_lm {
my ($target,$token,$tagstack,$parstack,$parser,$safeeval) = @_;
return '';
}
1;
__END__
Index: loncom/homework/units.json
+++ loncom/homework/units.json
{
"base": [
{ "name": "meter", "symbol": "m", "comment": "length" },
{ "name": "kilogram", "symbol": "kg", "comment": "mass" },
{ "name": "second", "symbol": "s", "comment": "time" },
{ "name": "ampere", "symbol": "A", "comment": "electric current" },
{ "name": "kelvin", "symbol": "K", "comment": "thermodynamic temperature" },
{ "name": "mole", "symbol": "mol", "comment": "amount of substance" },
{ "name": "candela", "symbol": "cd", "comment": "luminous intensity" },
{ "name": "decibel", "symbol": "dB", "comment": "log of pressure amplitude" }
],
"prefix": [
{ "name": "yotta", "symbol": "Y", "factor": "10^24" },
{ "name": "zetta", "symbol": "Z", "factor": "10^21" },
{ "name": "exa", "symbol": "E", "factor": "10^18" },
{ "name": "peta", "symbol": "P", "factor": "10^15" },
{ "name": "tera", "symbol": "T", "factor": "10^12" },
{ "name": "giga", "symbol": "G", "factor": "10^9" },
{ "name": "mega", "symbol": "M", "factor": "10^6" },
{ "name": "kilo", "symbol": "k", "factor": "10^3" },
{ "name": "hecto", "symbol": "h", "factor": "10^2" },
{ "name": "deca", "symbol": "D", "factor": "10^1" },
{ "name": "deci", "symbol": "d", "factor": "10^-1" },
{ "name": "centi", "symbol": "c", "factor": "10^-2" },
{ "name": "milli", "symbol": "m", "factor": "10^-3" },
{ "name": "micro", "symbol": "u", "factor": "10^-6" },
{ "name": "micro", "symbol": "µ", "factor": "10^-6", "comment": "micro sign character 00B5" },
{ "name": "micro", "symbol": "μ", "factor": "10^-6", "comment": "greek mu character 03BC" },
{ "name": "nano", "symbol": "n", "factor": "10^-9" },
{ "name": "pico", "symbol": "p", "factor": "10^-12" },
{ "name": "femto", "symbol": "f", "factor": "10^-15" },
{ "name": "atto", "symbol": "a", "factor": "10^-18" },
{ "name": "zepto", "symbol": "z", "factor": "10^-21" },
{ "name": "yocto", "symbol": "y", "factor": "10^-24" }
],
"derived": [
{ "name": "gram", "symbol": "g", "convert": "0.001 kg", "comment": "mass" },
{ "name": "minute", "symbol": "min", "convert": "60 s", "comment": "time" },
{ "name": "hour", "symbol": "hr", "convert": "3600 s", "comment": "time" },
{ "name": "hour", "symbol": "h", "convert": "3600 s", "comment": "time" },
{ "name": "day", "symbol": "day", "convert": "24.0 hr", "comment": "time" },
{ "name": "day", "symbol": "days", "convert": "24.0 hr", "comment": "time" },
{ "name": "year", "symbol": "yr", "convert": "365.24 day", "comment": "time" },
{ "name": "pound", "symbol": "lb", "convert": "0.45359237 kg", "comment": "mass" },
{ "name": "ounce", "symbol": "oz", "convert": "2.83495E-2 kg", "comment": "mass" },
{ "name": "inch", "symbol": "in", "convert": "2.54 cm", "comment": "length" },
{ "name": "foot", "symbol": "ft", "convert": "12 in", "comment": "length" },
{ "name": "mile", "symbol": "mi", "convert": "5280 ft", "comment": "length" },
{ "name": "yard", "symbol": "yd", "convert": "0.9144 m", "comment": "length" },
{ "name": "nautical_mile", "symbol": "n_mi", "convert": "6080 ft", "comment": "length, nautical mile (UK)" },
{ "name": "astroUnit", "symbol": "AU", "convert": "1.49598E11 m", "comment": "length, mean distance earth to sun" },
{ "name": "parsec", "symbol": "pc", "convert": "3.08568025E16 m", "comment": "length" },
{ "name": "light-year", "symbol": "ly", "convert": "9460730472580800 m", "comment": "length" },
{ "name": "rood", "symbol": "rood", "convert": "1210 yd^2", "comment": "area, rood" },
{ "name": "acre", "symbol": "acre", "convert": "4840 yd^2", "comment": "area, acre" },
{ "name": "hertz", "symbol": "Hz", "convert": "1/s", "comment": "frequency" },
{ "name": "litre", "symbol": "L", "convert": "10^3*cm^3", "comment": "volume" },
{ "name": "newton", "symbol": "N", "convert": "m*kg/s^2", "comment": "force" },
{ "name": "pound_force", "symbol": "lbf", "convert": "4.44822 N", "comment": "force" },
{ "name": "dyne", "symbol": "dyn", "convert": "1E-5 N", "comment": "force" },
{ "name": "pascal", "symbol": "Pa", "convert": "N/m^2", "comment": "pressure, stress" },
{ "name": "bar", "symbol": "bar", "convert": "1E5 Pa", "comment": "pressure" },
{ "name": "mmHg", "symbol": "mmHg", "convert": "1.33322E2 Pa", "comment": "pressure, millimeter of mercury" },
{ "name": "torr", "symbol": "torr", "convert": "1 mmHg", "comment": "pressure" },
{ "name": "atm", "symbol": "atm", "convert": "760 torr", "comment": "standard atmosphere" },
{ "name": "joule", "symbol": "J", "convert": "N*m", "comment": "energy, work, heat" },
{ "name": "electronvolt", "symbol": "eV", "convert": "1.6021892E-19 J", "comment": "energy" },
{ "name": "calorie", "symbol": "cal", "convert": "4.1868 J", "comment": "energy" },
{ "name": "Btu", "symbol": "Btu", "convert": "1.05506E3 J", "comment": "energy" },
{ "name": "watt", "symbol": "W", "convert": "J/s", "comment": "power, radiant flux" },
{ "name": "coulomb", "symbol": "C", "convert": "A*s", "comment": "electric charge" },
{ "name": "volt", "symbol": "V", "convert": "J/C", "comment": "electric potential, electromotive force" },
{ "name": "ohm", "symbol": "ohm", "convert": "V/A", "comment": "electric resistance, use this in /ANS" },
{ "name": "ohm", "symbol": "ohms", "convert": "V/A", "comment": "electric resistance" },
{ "name": "ohm", "symbol": "Ohm", "convert": "V/A", "comment": "electric resistance" },
{ "name": "ohm", "symbol": "Ohms", "convert": "V/A", "comment": "electric resistance" },
{ "name": "mho", "symbol": "mho", "convert": "1/ohm", "comment": "electric conductance" },
{ "name": "mho", "symbol": "mhos", "convert": "1/ohm", "comment": "electric conductance" },
{ "name": "mho", "symbol": "Mho", "convert": "1/ohm", "comment": "electric conductance" },
{ "name": "mho", "symbol": "Mhos", "convert": "1/ohm", "comment": "electric conductance" },
{ "name": "siemens", "symbol": "S", "convert": "1/Ohm", "comment": "electric conductance" },
{ "name": "farad", "symbol": "F", "convert": "C/V", "comment": "electric capacitance" },
{ "name": "tesla", "symbol": "T", "convert": "V*s/m^2", "comment": "magnetic flux density" },
{ "name": "weber", "symbol": "Wb", "convert": "V*s", "comment": "magnetic flux" },
{ "name": "henry", "symbol": "H", "convert": "V*s/A", "comment": "inductance" },
{ "name": "radian", "symbol": "rad", "convert": "m/m", "comment": "plane angle" },
{ "name": "degree", "symbol": "deg", "convert": "1.745329E-2 rad", "comment": "plane angle (Pi rad=180 deg)" },
{ "name": "steradian", "symbol": "sr", "convert": "m^2 /m^2", "comment": "solid angle" },
{ "name": "lumen", "symbol": "lm", "convert": "cd*sr", "comment": "luminous flux" },
{ "name": "lux", "symbol": "lx", "convert": "cd*sr/m^2", "comment": "illuminance" },
{ "name": "becquerel", "symbol": "Bq", "convert": "1/s", "comment": "activity (radioactive)" },
{ "name": "curie", "symbol": "Ci", "convert": "3.70E10 Bq", "comment": "activity (radioactive)" },
{ "name": "gray", "symbol": "Gy", "convert": "J/kg", "comment": "absorbed dose (of radiation)" },
{ "name": "sievert", "symbol": "Sv", "convert": "J/kg", "comment": "dose equivalent (dose equivalent index)" },
{ "name": "celcius", "symbol": "degC", "convert": "1 K", "comment": "multiplicatively OK" },
{ "name": "fahrenheit", "symbol": "degF", "convert": "0.555555555 K", "comment": "multiplicatively OK" },
{ "name": "molarity", "symbol": "M", "convert": "mol/L", "comment": "chemisty" },
{ "name": "amu", "symbol": "amu", "convert": "1.66053873e-27 kg", "comment": "atomic mass unit" },
{ "name": "amu", "symbol": "u", "convert": "1.66053873e-27 kg", "comment": "atomic mass unit" },
{ "name": "cubiccentimeter", "symbol": "cc", "convert": "cm^3", "comment": "cubic centimeter" },
{ "name": "electroncharge", "symbol": "e", "convert": "1.6021892E-19 C", "comment": "elementary charge" },
{ "name": "hbar", "symbol": "hbar", "convert": "1.05457148E-34 m^2*kg/s", "comment": "Planck constant" },
{ "name": "milesperhour", "symbol": "mph", "convert": "0.44704 m/s", "comment": "miles per hour" },
{ "name": "rpm", "symbol": "rpm", "convert": "0.0166666667/s", "comment": "rounds per minute" },
{ "name": "rpm", "symbol": "rpms", "convert": "0.0166666667/s", "comment": "rounds per minute" }
]
}
Index: loncom/homework/math_parser/CalcEnv.pm
+++ loncom/homework/math_parser/CalcEnv.pm
# The LearningOnline Network with CAPA - LON-CAPA
# CalcEnv
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Calculation environment, using either units or variables.
##
package Apache::math_parser::CalcEnv;
use strict;
use warnings;
use utf8;
use File::Slurp;
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::Units';
##
# Constructor
# @param {boolean} unit_mode
##
sub new {
my $class = shift;
my $self = {
_unit_mode => shift // 0,
};
if ($self->{_unit_mode}) {
$self->{_units} = Units->new();
} else {
$self->{_variables} = { }; # hash variable name -> quantity
}
my $constants_txt = read_file("$Apache::lonnet::perlvar{'lonTabDir'}/constants.json");
$self->{_constants} = JSON::DWIW->new->from_json($constants_txt);
$self->{_tolerance} = 0;
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Unit mode ?
# @returns {boolean}
##
sub unit_mode {
my $self = shift;
return $self->{_unit_mode};
}
##
# Units
# @returns {Units}
##
sub units {
my $self = shift;
return $self->{_units};
}
##
# Variables
# @returns {Object.<string, Quantity>} hash variable name -> quantity
##
sub variables {
my $self = shift;
return $self->{_variables};
}
##
# The constants, read from constants.json.
# @returns {hash} A hash name -> hash with the keys value and units
##
sub constants {
my $self = shift;
return $self->{_constants};
}
##
# Tolerance
# @returns {string|float} tolerance
##
sub tolerance {
my $self = shift;
return $self->{_tolerance};
}
##
# Changes an existing unit or defines a new one.
# @param {string} symbol - name used in math expressions
# @param {string} convert - SI equivalent or using other units to help converting to SI
##
sub setUnit {
my( $self, $symbol, $convert ) = @_;
$self->units->{_derived}->{$symbol} = $convert;
}
##
# Changes an existing variable value or defines a new one.
# @param {string} symbol - name used in math expressions
# @param {float|Quantity} value - number value or Quantity
##
sub setVariable {
my( $self, $symbol, $value ) = @_;
if ($value->isa(Quantity)) {
$self->variables->{$symbol} = $value;
} else {
$self->variables->{$symbol} = Quantity->new($value);
}
}
##
# Defines the tolerance to use for = operations.
# @param {string|float} tolerance
##
sub setTolerance {
my( $self, $tolerance ) = @_;
$self->{_tolerance} = $tolerance;
}
##
# Returns a variable quantity or undef.
# @param {string} symbol - name used in math expressions
# @returns {Quantity}
##
sub getVariable {
my( $self, $symbol ) = @_;
return $self->variables->{$symbol};
}
##
# Returns a constant quantity or undef.
# @param {string} symbol - name used in math expressions
# @returns {Quantity}
##
sub getConstant {
my( $self, $symbol ) = @_;
my $cst = $self->constants->{$symbol};
if (!defined $cst) {
return undef;
}
return Quantity->new($cst->{"value"}, $cst->{"units"});
}
##
# Converts a unit name into a Quantity. Throws an exception if the unit is not known.
# @param {string} name - the unit name
# @returns {Quantity}
##
sub convertToSI {
my ( $self, $name ) = @_;
return $self->units->convertToSI($self, $name);
}
1;
__END__
Index: loncom/homework/math_parser/CalcException.pm
+++ loncom/homework/math_parser/CalcException.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Calculation exception
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Calculation exception
##
package Apache::math_parser::CalcException;
use strict;
use warnings;
use utf8;
use Apache::lonlocal;
use overload '""' => \&toString;
##
# Constructor
# @param {string} msg - error message, using [_1] for the first parameter
# @param {...string} param - parameters for the message
##
sub new {
my $class = shift;
my $self = {
_msg => shift,
_params => [],
};
while (@_) {
push(@{$self->{_params}}, shift);
}
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Error message, using [_1] for the first parameter.
# @returns {string}
##
sub msg {
my $self = shift;
return $self->{_msg};
}
##
# Parameters for the message.
# @returns {string[]}
##
sub params {
my $self = shift;
return $self->{_params};
}
##
# Returns the exception as a string, for debug only.
# @returns {string}
##
sub toString {
my $self = shift;
my $s = "Calculation error: ".$self->msg;
if (scalar(@{$self->params}) > 0) {
$s .= ", ".join(", ", @{$self->params});
}
return $s;
}
##
# Returns the error message localized for the user interface.
# @returns {string}
##
sub getLocalizedMessage {
my $self = shift;
return mt($self->msg, @{$self->params});
}
1;
__END__
Index: loncom/homework/math_parser/Definitions.pm
+++ loncom/homework/math_parser/Definitions.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Operator definitions
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Operator definitions (see function define() at the end).
##
package Apache::math_parser::Definitions;
use strict;
use warnings;
use utf8;
use JSON::DWIW;
use File::Slurp;
use aliased 'Apache::math_parser::ENode';
use aliased 'Apache::math_parser::Operator';
use aliased 'Apache::math_parser::ParseException';
use aliased 'Apache::math_parser::Parser';
use aliased 'Apache::math_parser::Token';
use constant ARG_SEPARATOR => ","; # ";" would be more international
use constant DECIMAL_SIGN_1 => ".";
use constant DECIMAL_SIGN_2 => "."; # with "," here
use constant INTERVAL_SEPARATOR => ":";
use vars qw(%perlvar);
##
# Constructor
##
sub new {
my $class = shift;
my $self = {
_operators => [], # Array of Operator
};
bless $self, $class;
return $self;
}
# Attribute helpers
##
# The operators.
# @returns {Operator[]}
##
sub operators {
my $self = shift;
return $self->{_operators};
}
##
# Creates a new operator.
# @param {string} id - Operator id (text used to recognize it)
# @param {integer} arity - Operator->UNARY, BINARY or TERNARY
# @param {integer} lbp - Left binding power
# @param {integer} rbp - Right binding power
# @param {function} nud - Null denotation function. Parameters: Operator, Parser. Returns: ENode.
# @param {function} led - Left denotation function. Parameters: Operator, Parser, ENode. Returns: ENode.
##
sub operator {
my( $self, $id, $arity, $lbp, $rbp, $nud, $led ) = @_;
push(@{$self->{_operators}}, Operator->new($id, $arity, $lbp, $rbp, $nud, $led));
}
##
# Creates a new separator operator.
# @param {string} id - Operator id (text used to recognize it)
##
sub separator {
my( $self, $id ) = @_;
$self->operator($id, Operator->BINARY, 0, 0);
}
##
# Creates a new infix operator.
# @param {string} id - Operator id (text used to recognize it)
# @param {integer} lbp - Left binding power
# @param {integer} rbp - Right binding power
# @optional {function} led - Left denotation function
##
sub infix {
my( $self, $id, $lbp, $rbp, $led ) = @_;
my $arity = Operator->BINARY;
my $nud = undef;
if (!defined $led) {
$led = sub {
my( $op, $p, $left ) = @_;
my @children = ($left, $p->expression($rbp));
return ENode->new(ENode->OPERATOR, $op, $id, \@children);
}
}
$self->operator($id, $arity, $lbp, $rbp, $nud, $led);
}
##
# Creates a new prefix operator.
# @param {string} id - Operator id (text used to recognize it)
# @param {integer} rbp - Right binding power
# @optional {function} nud - Null denotation function
##
sub prefix {
my( $self, $id, $rbp, $nud ) = @_;
my $arity = Operator->UNARY;
my $lbp = 0;
if (!defined $nud) {
$nud = sub {
my( $op, $p ) = @_;
my @children = ($p->expression($rbp));
return ENode->new(ENode->OPERATOR, $op, $id, \@children);
}
}
my $led = undef;
$self->operator($id, $arity, $lbp, $rbp, $nud, $led);
}
##
# Creates a new suffix operator.
# @param {string} id - Operator id (text used to recognize it)
# @param {integer} lbp - Left binding power
# @optional {function} led - Left denotation function
##
sub suffix {
my( $self, $id, $lbp, $led ) = @_;
my $arity = Operator->UNARY;
my $rbp = 0;
my $nud = undef;
if (!defined $led) {
$led = sub {
my( $op, $p, $left ) = @_;
my @children = ($left);
return ENode->new(ENode->OPERATOR, $op, $id, \@children);
}
}
$self->operator($id, $arity, $lbp, $rbp, $nud, $led);
}
##
# Returns the defined operator with the given id
# @param {string} id - Operator id (text used to recognize it)
# @returns {Operator}
##
sub findOperator {
my( $self, $id ) = @_;
for (my $i=0; $i<scalar(@{$self->operators}); $i++) {
if (@{$self->operators}[$i]->id eq $id) {
return(@{$self->operators}[$i]);
}
}
return undef;
}
##
# Led function for the ` (units) operator
# @param {Operator} op
# @param {Parser} p
# @param {ENode} left
# @returns {ENode}
##
sub unitsLed {
my( $op, $p, $left ) = @_;
# this led for units gathers all the units in an ENode
my $right = $p->expression(125);
while (defined $p->current_token && index("*/", $p->current_token->value) != -1) {
my $token2 = $p->tokens->[$p->token_nr];
if (!defined $token2) {
last;
}
if ($token2->type != Token->NAME && $token2->value ne "(") {
last;
}
my $token3 = $p->tokens->[$p->token_nr + 1];
if (defined $token3 && ($token3->value eq "(" || $token3->type == Token->NUMBER)) {
last;
}
# a check for constant names here is not needed because constant names are replaced in the tokenizer
my $t = $p->current_token;
$p->advance();
$right = $t->op->led->($t->op, $p, $right);
}
my @children = ($left, $right);
return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
}
##
# nud function for the ( operator (used to parse mathematical sub-expressions and intervals)
# @param {Operator} op
# @param {Parser} p
# @returns {ENode}
##
sub parenthesisNud {
my( $op, $p ) = @_;
my $e = $p->expression(0);
if (defined $p->current_token && defined $p->current_token->op &&
$p->current_token->op->id eq INTERVAL_SEPARATOR) {
return buildInterval(0, $e, $op, $p);
}
$p->advance(")");
return $e;
}
##
# Led function for the ( operator (used to parse function calls)
# @param {Operator} op
# @param {Parser} p
# @param {ENode} left
# @returns {ENode}
##
sub parenthesisLed {
my( $op, $p, $left ) = @_;
if ($left->type != ENode->NAME && $left->type != ENode->SUBSCRIPT) {
die ParseException->new("Function name expected before a parenthesis.", $p->tokens->[$p->token_nr - 1]->from);
}
my @children = ($left);
if ((!defined $p->current_token) || (!defined $p->current_token->op) || ($p->current_token->op->id ne ")")) {
while (1) {
push(@children, $p->expression(0));
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
last;
}
$p->advance(ARG_SEPARATOR);
}
}
$p->advance(")");
return ENode->new(ENode->FUNCTION, $op, $op->id, \@children);
}
##
# nud function for the [ operator (used to parse vectors and intervals)
# @param {Operator} op
# @param {Parser} p
# @returns {ENode}
##
sub squareBracketNud {
my( $op, $p ) = @_;
my @children = ();
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne "]") {
my $e = $p->expression(0);
if (defined $p->current_token && defined $p->current_token->op &&
$p->current_token->op->id eq INTERVAL_SEPARATOR) {
return buildInterval(1, $e, $op, $p);
}
while (1) {
push(@children, $e);
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
last;
}
$p->advance(ARG_SEPARATOR);
$e = $p->expression(0);
}
}
$p->advance("]");
return ENode->new(ENode->VECTOR, $op, undef, \@children);
}
##
# Led function for the [ operator (used to parse subscript)
# @param {Operator} op
# @param {Parser} p
# @param {ENode} left
# @returns {ENode}
##
sub subscriptLed {
my( $op, $p, $left ) = @_;
if ($left->type != ENode->NAME && $left->type != ENode->SUBSCRIPT) {
die ParseException->new("Name expected before a square bracket.", $p->tokens->[$p->token_nr - 1]->from);
}
my @children = ($left);
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id != "]") {
while (1) {
push(@children, $p->expression(0));
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
last;
}
$p->advance(ARG_SEPARATOR);
}
}
$p->advance("]");
return ENode->new(ENode->SUBSCRIPT, $op, "[", \@children);
}
##
# Returns the ENode for the interval, parsing starting just before the interval separator
# @param {boolean} closed - was the first operator closed ?
# @param {ENode} e1 - First argument (already parsed)
# @param {Operator} op - The operator
# @param {Parser} p - The parser
# @returns {ENode}
##
sub buildInterval {
my ($closed, $e1, $op, $p) = @_;
$p->advance(INTERVAL_SEPARATOR);
my $e2 = $p->expression(0);
if (!defined $p->current_token || !defined $p->current_token->op ||
($p->current_token->op->id ne ")" && $p->current_token->op->id ne "]")) {
die ParseException->new("Wrong interval syntax.", $p->tokens->[$p->token_nr - 1]->from);
}
my $interval_type;
if ($p->current_token->op->id eq ")") {
$p->advance(")");
if ($closed) {
$interval_type = ENode->CLOSED_OPEN;
} else {
$interval_type = ENode->OPEN_OPEN;
}
} else {
$p->advance("]");
if ($closed) {
$interval_type = ENode->CLOSED_CLOSED;
} else {
$interval_type = ENode->OPEN_CLOSED;
}
}
return ENode->new(ENode->INTERVAL, $op, undef, [$e1, $e2], $interval_type);
}
##
# nud function for the { operator (used to parse sets)
# @param {Operator} op
# @param {Parser} p
# @returns {ENode}
##
sub curlyBracketNud {
my( $op, $p ) = @_;
my @children = ();
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne "}") {
while (1) {
push(@children, $p->expression(0));
if (!defined $p->current_token || !defined $p->current_token->op || $p->current_token->op->id ne ARG_SEPARATOR) {
last;
}
$p->advance(ARG_SEPARATOR);
}
}
$p->advance("}");
return ENode->new(ENode->SET, $op, undef, \@children);
}
##
# Defines all the operators.
##
sub define {
my( $self ) = @_;
$self->suffix("!", 160);
$self->infix("^", 140, 139);
$self->infix(".", 130, 129);
$self->infix("`", 125, 125, \&unitsLed);
$self->infix("*", 120, 120);
$self->infix("/", 120, 120);
$self->infix("%", 120, 120);
$self->infix("+", 100, 100);
$self->operator("-", Operator->BINARY, 100, 134, sub {
my( $op, $p ) = @_;
my @children = ($p->expression($op->rbp));
return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
}, sub {
my( $op, $p, $left ) = @_;
my @children = ($left, $p->expression(100));
return ENode->new(ENode->OPERATOR, $op, $op->id, \@children);
});
$self->infix("=", 80, 80);
$self->infix("#", 80, 80);
$self->infix("<=", 80, 80);
$self->infix(">=", 80, 80);
$self->infix("<", 80, 80);
$self->infix(">", 80, 80);
$self->separator(")");
$self->separator(ARG_SEPARATOR);
$self->separator(INTERVAL_SEPARATOR);
$self->operator("(", Operator->BINARY, 200, 200, \&parenthesisNud, \&parenthesisLed);
$self->separator("]");
$self->operator("[", Operator->BINARY, 200, 70, \&squareBracketNud, \&subscriptLed);
$self->separator("}");
$self->prefix("{", 200, \&curlyBracketNud);
}
1;
__END__
Index: loncom/homework/math_parser/ENode.pm
+++ loncom/homework/math_parser/ENode.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Parsed tree node
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Parsed tree node. ENode.toMathML(hcolors) contains the code for the transformation into MathML.
##
package Apache::math_parser::ENode;
use strict;
use warnings;
use utf8;
use feature "switch"; # Perl 5.10.1
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Operator';
use aliased 'Apache::math_parser::ParseException';
use aliased 'Apache::math_parser::QMatrix';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QVector';
use aliased 'Apache::math_parser::QInterval';
use aliased 'Apache::math_parser::QIntervalUnion';
use aliased 'Apache::math_parser::QSet';
use aliased 'Apache::math_parser::Units';
use enum qw(UNKNOWN NAME NUMBER OPERATOR FUNCTION VECTOR INTERVAL SET SUBSCRIPT);
use enum qw(NOT_AN_INTERVAL OPEN_OPEN OPEN_CLOSED CLOSED_OPEN CLOSED_CLOSED);
##
# @param {integer} type - UNKNOWN | NAME | NUMBER | OPERATOR | FUNCTION | VECTOR | INTERVAL | SET | SUBSCRIPT
# @param {Operator} op - The operator
# @param {string} value - Node value as a string, undef for type VECTOR
# @param {ENode[]} children - The children nodes, only for types OPERATOR, FUNCTION, VECTOR, INTERVAL, SET, SUBSCRIPT
# @param {interval_type} - The interval type, NOT_AN_INTERVAL | OPEN_OPEN | OPEN_CLOSED | CLOSED_OPEN | CLOSED_CLOSED
##
sub new {
my $class = shift;
my $self = {
_type => shift,
_op => shift,
_value => shift,
_children => shift,
_interval_type => shift // NOT_AN_INTERVAL,
};
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Node type
# @returns {int} UNKNOWN | NAME | NUMBER | OPERATOR | FUNCTION | VECTOR | INTERVAL | SET | SUBSCRIPT
##
sub type {
my $self = shift;
return $self->{_type};
}
##
# Operator
# @returns {Operator}
##
sub op {
my $self = shift;
return $self->{_op};
}
##
# Node value as a string, undef for type VECTOR.
# @returns {string}
##
sub value {
my $self = shift;
return $self->{_value};
}
##
# The children nodes, only for types OPERATOR, FUNCTION, VECTOR, INTERVAL, SET, SUBSCRIPT
# @returns {ENode[]}
##
sub children {
my $self = shift;
return $self->{_children};
}
##
# The interval type, NOT_AN_INTERVAL | OPEN_OPEN | OPEN_CLOSED | CLOSED_OPEN | CLOSED_CLOSED
# @returns {int}
##
sub interval_type {
my $self = shift;
return $self->{_interval_type};
}
##
# Returns the node as a string, for debug
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s = '(';
given ($self->type) {
when (UNKNOWN) { $s .= "UNKNOWN"; }
when (NAME) { $s .= "NAME"; }
when (NUMBER) { $s .= "NUMBER"; }
when (OPERATOR) { $s .= "OPERATOR"; }
when (FUNCTION) { $s .= "FUNCTION"; }
when (VECTOR) { $s .= "VECTOR"; }
when (INTERVAL) { $s .= "INTERVAL"; }
when (SET) { $s .= "SET"; }
when (SUBSCRIPT) { $s .= "SUBSCRIPT"; }
}
if (defined $self->op) {
$s .= " '" . $self->op->id . "'";
}
if (defined $self->value) {
$s .= " '" . $self->value . "'";
}
if (defined $self->{_children}) {
$s .= ' [';
for (my $i = 0; $i < scalar(@{$self->children}); $i++) {
$s .= $self->children->[$i]->toString();
if ($i != scalar(@{$self->children}) - 1) {
$s .= ',';
}
}
$s .= ']';
}
if (defined $self->interval_type) {
$s .= " " . $self->interval_type;
}
$s.= ')';
return $s;
}
##
# Evaluates the node, returning a quantity or an object from a more complex class using quantities as base components.
# Can throw a CalcException if a result cannot be calculated.
# @param {CalcEnv} env - Calculation environment.
# @returns {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion}
##
sub calc {
my ( $self, $env ) = @_;
given ($self->type) {
when (UNKNOWN) {
die CalcException->new("Unknown node type: [_1].", $self->value);
}
when (NAME) {
my $name = $self->value;
if ($name =~ /^inf$/i) {
return Quantity->new(9**9**9);
} elsif ($name =~ /^nan$/i) {
return Quantity->new(-sin(9**9**9));
}
if ($env->unit_mode) {
my $cst = $env->getConstant($name);
if (defined $cst) {
return $cst;
}
return $env->convertToSI($name);
} else {
my $q = $env->getVariable($name);
if (!defined $q) {
my $cst = $env->getConstant($name);
if (defined $cst) {
return $cst;
}
die CalcException->new("Variable has undefined value: [_1].", $name);
}
return $q;
}
}
when (NUMBER) {
return Quantity->new($self->value);
}
when (OPERATOR) {
my @children = @{$self->children};
my ($q1, $q2);
if (defined $children[0]) {
$q1 = $children[0]->calc($env);
}
if (defined $children[1]) {
$q2 = $children[1]->calc($env);
}
given ($self->value) {
when ("+") {
if (!overload::Method($q1, '+')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 + $q2);
}
when ("-") {
if (!defined $q2) {
if (!$q1->can('qneg')) {
die CalcException->new("Negation is not implemented for this type.");
}
return($q1->qneg());
} else {
if (!overload::Method($q1, '-')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 - $q2);
}
}
when ("*") {
if (!overload::Method($q1, '*')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 * $q2);
}
when ("/") {
if (!overload::Method($q1, '/')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 / $q2);
}
when ("^") {
if (!overload::Method($q1, '^')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 ^ $q2);
}
when ("!") {
if (!$q1->can('qfact')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return $q1->qfact();
}
when ("%") {
if (!$q1->isa(Quantity) || !$q2->isa(Quantity)) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return(($q1 / Quantity->new(100)) * $q2);
}
when (".") {
# scalar product for vectors, multiplication for matrices
if (!$q1->can('qdot')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1->qdot($children[1]->calc($env)));
}
when ("`") {
if (!overload::Method($q1, '*')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 * $q2);
}
when ("=") {
if (!$q1->can('qeq')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1->qeq($q2, $env->tolerance));
}
when ("<") {
if (!overload::Method($q1, '<')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 < $q2);
}
when ("<=") {
if (!overload::Method($q1, '<=')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 <= $q2);
}
when (">") {
if (!overload::Method($q1, '>')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 > $q2);
}
when (">=") {
if (!overload::Method($q1, '>=')) {
die CalcException->new("The [_1] operator is not implemented for this type.", $self->value);
}
return($q1 >= $q2);
}
default {
die CalcException->new("Unknown operator: [_1].", $self->value);
}
}
}
when (FUNCTION) {
my @children = @{$self->children};
my $fname = $children[0]->value;
if (!defined $children[1]) {
die CalcException->new("Missing parameter for function [_1].", $fname);
}
my ($q1, $q2);
if ($fname ~~ ['pow', 'sqrt', 'abs', 'exp', 'ln', 'log', 'log10', 'factorial',
'mod', 'sgn', 'ceil', 'floor', 'sin', 'cos', 'tan', 'asin', 'acos', 'atan',
'atan2', 'sinh', 'cosh', 'tanh', 'asinh', 'acosh', 'atanh']) {
$q1 = $children[1]->calc($env);
if (!$q1->isa(Quantity)) {
die CalcException->new("The [_1] function is not implemented for this type.", $fname);
}
}
if ($fname ~~ ['pow', 'mod', 'atan2']) {
if (!defined $children[2]) {
die CalcException->new("Missing parameter for function [_1].", $fname);
}
$q2 = $children[2]->calc($env);
if (!$q2->isa(Quantity)) {
die CalcException->new("The [_1] function is not implemented for this type.", $fname);
}
}
given ($fname) {
when ("matrix") { return $self->createVectorOrMatrix($env); }
when ("pow") { return $q1->qpow($q2); }
when ("sqrt") { return $q1->qsqrt(); }
when ("abs") { return $q1->qabs(); }
when ("exp") { return $q1->qexp(); }
when ("ln") { return $q1->qln(); }
when ("log") { return $q1->qln(); }
when ("log10") { return $q1->qlog10(); }
when ("factorial") { return $q1->qfact(); }
when ("mod") { return $q1->qmod($q2); }
when ("sgn") { return $q1->qsgn(); }
when ("ceil") { return $q1->qceil(); }
when ("floor") { return $q1->qfloor(); }
when ("sin") { return $q1->qsin(); }
when ("cos") { return $q1->qcos(); }
when ("tan") { return $q1->qtan(); }
when ("asin") { return $q1->qasin(); }
when ("acos") { return $q1->qacos(); }
when ("atan") { return $q1->qatan(); }
when ("atan2") { return $q1->qatan2($q2); }
when ("sinh") { return $q1->qsinh(); }
when ("cosh") { return $q1->qcosh(); }
when ("tanh") { return $q1->qtanh(); }
when ("asinh") { return $q1->qasinh(); }
when ("acosh") { return $q1->qacosh(); }
when ("atanh") { return $q1->qatanh(); }
when (["sum","product"]) {
if ($env->unit_mode) {
die CalcException->new("[_1] cannot work in unit mode.", $fname);
}
if (scalar(@children) != 5) {
die CalcException->new("[_1] should have four parameters.", $fname);
}
my $var = "".$children[2]->value;
if ($var !~ /^[a-zA-Z_][a-zA-Z_0-9]*$/) {
die CalcException->new("[_1]: wrong variable name", $fname);
}
if ($var eq "i") {
die CalcException->new("[_1]: please use another variable name, i is the imaginary number.", $fname);
}
my $initial = $env->getVariable($var);
my $var_value_1 = $children[3]->value;
my $var_value_2 = $children[4]->value;
if ($var_value_1 !~ /^[0-9]+$/) {
die CalcException->new("[_1]: the third parameter should be an integer", $fname);
}
if ($var_value_2 !~ /^[0-9]+$/) {
die CalcException->new("[_1]: the fourth parameter should be an integer", $fname);
}
if ($var_value_1 > $var_value_2) {
die CalcException->new("[_1]: are you trying to make me loop forever?", $fname);
}
my $result;
for (my $var_value=$var_value_1; $var_value <= $var_value_2; $var_value++) {
$env->setVariable($var, $var_value);
my $nq = $children[1]->calc($env);
if (!$nq->isa(Quantity) && !$nq->isa(QVector) && !$nq->isa(QMatrix)) {
die CalcException->new("[_1]: wrong type for a calculated value", $fname);
}
if (!defined $result) {
$result = $nq;
} elsif ($fname eq "sum") {
$result += $nq;
} else {
$result *= $nq;
}
}
$env->setVariable($var, $initial);
return $result;
}
when ("binomial") {
if (scalar(@children) != 3) {
die CalcException->new("[_1] should have two parameters.", $fname);
}
my $n = $children[1]->calc($env);
my $p = $children[2]->calc($env);
if (!$n->isa(Quantity) || !$p->isa(Quantity)) {
die CalcException->new("Wrong parameter type for function [_1]", $fname);
}
return $n->qfact() / ($p->qfact() * ($n - $p)->qfact());
}
when (["union","intersection"]) {
if (!defined $children[2]) {
die CalcException->new("Missing parameter for function [_1].", $fname);
}
my $p1 = $children[1]->calc($env);
my $p2 = $children[2]->calc($env);
if (!$p1->isa(QSet) && !$p1->isa(QInterval) && !$p1->isa(QIntervalUnion)) {
die CalcException->new("Wrong type for function [_1] (should be a set or interval).", $fname);
}
if ($fname eq "union") {
return $p1->union($p2);
} else {
return $p1->intersection($p2);
}
}
default { die CalcException->new("Unknown function: [_1].",$fname); }
}
}
when (VECTOR) {
return $self->createVectorOrMatrix($env);
}
when (INTERVAL) {
my @children = @{$self->children};
if (scalar(@children) != 2) {
die CalcException->new("Interval should have two parameters.");
}
my $qmin = $children[0]->calc($env);
my $qmax = $children[1]->calc($env);
my ($qminopen, $qmaxopen);
given ($self->interval_type) {
when (OPEN_OPEN) { $qminopen = 1; $qmaxopen = 1; }
when (OPEN_CLOSED) { $qminopen = 1; $qmaxopen = 0; }
when (CLOSED_OPEN) { $qminopen = 0; $qmaxopen = 1; }
when (CLOSED_CLOSED) { $qminopen = 0; $qmaxopen = 0; }
}
return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
}
when (SET) {
my @t = ();
foreach my $child (@{$self->children}) {
push(@t, $child->calc($env));
}
return QSet->new(\@t);
}
when (SUBSCRIPT) {
die CalcException->new("Subscript cannot be evaluated: [_1].", $self->value);
}
}
}
##
# Returns the equation as a string with the Maxima syntax.
# @returns {string}
##
sub toMaxima {
my ( $self, $env ) = @_;
given ($self->type) {
when (UNKNOWN) {
die CalcException->new("Unknown node type: [_1].", $self->value);
}
when (NAME) {
my $name = $self->value;
my $cst = $env->getConstant($name);
if (defined $cst) {
return $cst;
}
return($name);
}
when (NUMBER) {
if ($self->value eq "i") {
return "%i";
} else {
return $self->value;
}
}
when (OPERATOR) {
my @children = @{$self->children};
given ($self->value) {
when ("+") {
if ($children[0]->type == SET && $children[1]->type == SET) {
return("union(".$children[0]->toMaxima().", ".$children[1]->toMaxima().")");
} else {
return("(".$children[0]->toMaxima()."+".$children[1]->toMaxima().")");
}
}
when ("-") {
if (!defined $children[1]) {
return("(-".$children[0]->toMaxima().")");
} else {
return("(".$children[0]->toMaxima()."-".$children[1]->toMaxima().")");
}
}
when ("*") {
return("(".$children[0]->toMaxima()."*".$children[1]->toMaxima().")");
}
when ("/") {
return("(".$children[0]->toMaxima()."/".$children[1]->toMaxima().")");
}
when ("^") {
return("(".$children[0]->toMaxima()."^".$children[1]->toMaxima().")");
}
when ("!") {
return("factorial(".$children[0]->toMaxima().")");
}
when ("%") {
return("((".$children[0]->toMaxima()."/100)*".$children[1]->toMaxima().")");
}
when (".") {
# scalar product for vectors, multiplication for matrices
return("(".$children[0]->toMaxima().".".$children[1]->toMaxima().")");
}
when ("`") {
return("(".$children[0]->toMaxima()."`".$children[1]->toMaxima().")");
}
when ("=") {
# NOTE: should we use is(...) to evaluate the expression ?
return("(".$children[0]->toMaxima()."=".$children[1]->toMaxima().")");
}
when ("<") {
return("(".$children[0]->toMaxima()."<".$children[1]->toMaxima().")");
}
when (">") {
return("(".$children[0]->toMaxima().">".$children[1]->toMaxima().")");
}
when ("<=") {
return("(".$children[0]->toMaxima()."<=".$children[1]->toMaxima().")");
}
when (">=") {
return("(".$children[0]->toMaxima().">=".$children[1]->toMaxima().")");
}
default {
die CalcException->new("Unknown operator: [_1].", $self->value);
}
}
}
when (FUNCTION) {
my @children = @{$self->children};
my $fname = $children[0]->value;
given ($fname) {
when ("log10") { return "log(".$children[1]->toMaxima().")/log(10)"; }
when ("sgn") { return "signum(".$children[1]->toMaxima().")"; }
when ("ceil") { return "ceiling(".$children[1]->toMaxima().")"; }
default {
my $s = $fname."(";
for (my $i=1; $i<scalar(@children); $i++) {
if ($i != 1) {
$s .= ", ";
}
$s .= $children[$i]->toMaxima();
}
$s .= ")";
return($s);
}
}
}
when (VECTOR) {
my @children = @{$self->children};
my $s;
if ($children[0]->type == VECTOR) {
$s = "matrix(";
} else {
$s = "[";
}
for (my $i=0; $i<scalar(@children); $i++) {
if ($i != 0) {
$s .= ", ";
}
$s .= $children[$i]->toMaxima();
}
if ($children[0]->type == VECTOR) {
$s .= ")";
} else {
$s .= "]";
}
return($s);
}
when (INTERVAL) {
die CalcException->new("Maxima syntax: intervals are not implemented.");
# see http://ieeexplore.ieee.org/xpls/icp.jsp?arnumber=5959544
# "New Package in Maxima for Single-Valued Interval Computation on Real Numbers"
}
when (SET) {
my @children = @{$self->children};
my $s = "{";
for (my $i=0; $i<scalar(@children); $i++) {
if ($i != 0) {
$s .= ", ";
}
$s .= $children[$i]->toMaxima();
}
$s .= "}";
return($s);
}
when (SUBSCRIPT) {
my @children = @{$self->children};
return("(".$children[0]->toMaxima()."_".$children[1]->toMaxima().")");
}
}
}
##
# Returns the equation as a string with the TeX syntax.
# @returns {string}
##
sub toTeX {
my ( $self ) = @_;
given ($self->type) {
when (UNKNOWN) {
die CalcException->new("Unknown node type: [_1].", $self->value);
}
when (NAME) {
my $name = $self->value;
if ($name =~ /^([a-zA-Z]+)([0-9]+)$/) {
return($1."_{".$2."}");
}
my @greek = (
"alpha", "beta", "gamma", "delta", "epsilon", "zeta",
"eta", "theta", "iota", "kappa", "lambda", "mu",
"nu", "xi", "omicron", "pi", "rho", "sigma",
"tau", "upsilon", "phi", "chi", "psi", "omega",
"Alpha", "Beta", "Gamma", "Delta", "Epsilon", "Zeta",
"Eta", "Theta", "Iota", "Kappa", "Lambda", "Mu",
"Nu", "Xi", "Omicron", "Pi", "Rho", "Sigma",
"Tau", "Upsilon", "Phi", "Chi", "Psi", "Omega",
);
if ($name ~~ @greek) {
return('\\'.$name);
} elsif ($name eq "hbar") {
return("\\hbar");
} elsif ($name eq "inf") {
return("\\infty");
} elsif ($name eq "minf") {
return("-\\infty");
} else {
return($name);
}
}
when (NUMBER) {
return $self->value;
}
when (OPERATOR) {
my @children = @{$self->children};
my $c0 = $children[0];
my $c1 = $children[1];
given ($self->value) {
when ("+") {
# should we add parenthesis ? We need to check if there is a '-' to the left of c1
my $par = 0;
my $first = $c1;
while ($first->type == OPERATOR) {
if ($first->value eq "-" && scalar(@{$first->children}) == 1) {
$par = 1;
last;
} elsif ($first->value eq "+" || $first->value eq "-" || $first->value eq "*") {
$first = $first->children->[0];
} else {
last;
}
}
my $s = $c0->toTeX()." + ".$c1->toTeX();
if ($par) {
$s = "(".$s.")";
}
return $s;
}
when ("-") {
if (!defined $c1) {
return("-".$c0->toTeX());
} else {
my $s = $c0->toTeX()." - ";
my $par = ($c1->type == OPERATOR &&
($c1->value eq "+" || $c1->value eq "-"));
if ($par) {
$s .= "(".$c1->toTeX().")";
} else {
$s .= $c1->toTeX();
}
return $s;
}
}
when ("*") {
my $par = ($c0->type == OPERATOR && ($c0->value eq "+" || $c0->value eq "-"));
my $s = $c0->toTeX();
if ($par) {
$s = "(".$s.")";
}
# should the x operator be visible ? We need to check if there is a number to the left of c1
my $firstinc1 = $c1;
while ($firstinc1->type == OPERATOR) {
$firstinc1 = $firstinc1->children->[0];
}
# ... and if it's an operation between vectors/matrices, the * operator should be displayed
# (it is ambiguous otherwise)
# note: this will not work if the matrix is calculated, for instance with 2[1;2]*[3;4]
if ($c0->type == VECTOR && $c1->type == VECTOR) {
$s .= " * ";
} elsif ($firstinc1->type == NUMBER) {
$s .= " \\times ";
} else {
$s .= " ";
}
$par = ($c1->type == OPERATOR && ($c1->value eq "+" || $c1->value eq "-"));
if ($par) {
$s .= "(".$c1->toTeX().")";
} else {
$s .= $c1->toTeX();
}
return $s;
}
when ("/") {
# NOTE: cfrac would be better but tth does not handle it
return("\\frac{".$c0->toTeX()."}{".$c1->toTeX()."}");
}
when ("^") {
my $par;
if ($c0->type == FUNCTION) {
if ($c0->value eq "sqrt" || $c0->value eq "abs" || $c0->value eq "matrix" ||
$c0->value eq "diff") {
$par = 0;
} else {
$par = 1;
}
} elsif ($c0->type == OPERATOR) {
$par = 1;
} else {
$par = 0;
}
if ($par) {
return("(".$c0->toTeX().")^{".$c1->toTeX()."}");
} else {
return($c0->toTeX()."^{".$c1->toTeX()."}");
}
}
when ("!") {
return($c0->toTeX()." !");
}
when ("%") {
return($c0->toTeX()." \\% ".$c1->toTeX());
}
when (".") {
# scalar product for vectors, multiplication for matrices
my $par = ($c0->type == OPERATOR && ($c0->value eq "+" || $c0->value eq "-"));
my $s = $c0->toTeX();
if ($par) {
$s = "(".$s.")";
}
$s .= " \\cdot ";
$par = ($c1->type == OPERATOR && ($c1->value eq "+" || $c1->value eq "-"));
if ($par) {
$s .= "(".$c1->toTeX().")";
} else {
$s .= $c1->toTeX();
}
return $s;
}
when ("`") {
return($c0->toTeX()." \\mathrm{".$c1->toTeX()."}");
}
when ("=") {
return($c0->toTeX()." = ".$c1->toTeX());
}
when ("#") {
return($c0->toTeX()." \\not ".$c1->toTeX());
}
when ("<") {
return($c0->toTeX()." < ".$c1->toTeX());
}
when (">") {
return($c0->toTeX()." > ".$c1->toTeX());
}
when ("<=") {
return($c0->toTeX()." \\leq ".$c1->toTeX());
}
when (">=") {
return($c0->toTeX()." \\geq ".$c1->toTeX());
}
default {
die CalcException->new("Unknown operator: [_1].", $self->value);
}
}
}
when (FUNCTION) {
my @children = @{$self->children};
my $fname = $children[0]->value;
my $c1 = $children[1];
my $c2 = $children[2];
my $c3 = $children[3];
my $c4 = $children[4];
given ($fname) {
when ("sqrt") { return "\\sqrt{".$c1->toTeX()."}"; }
when ("abs") { return "|".$c1->toTeX()."|"; }
when ("exp") { return "\\mathrm{e}^{".$c1->toTeX()."}"; }
when ("diff") {
if (scalar(@children) == 3) {
return "\\frac{d}{d".$c2->toTeX()."} ".$c1->toTeX();
} else {
return "\\frac{d^{".$c3->toTeX()."}}{d ".$c2->toTeX().
"^{".$c3->toTeX()."}} ".$c1->toTeX();
}
}
when ("integrate") {
if (scalar(@children) == 3) {
return "\\int ".$c1->toTeX()." \\ d ".$c2->toTeX();
} else {
return "\\int_{".$c3->toTeX()."}^{".$c4->toTeX()."} ".
$c1->toTeX()." \\ d ".$c2->toTeX();
}
}
when ("sum") {
return "\\sum_{".$c2->toTeX()."=".$c3->toTeX().
"}^{".$c4->toTeX()."} ".$c1->toTeX();
}
when ("product") {
return "\\prod_{".$c2->toTeX()."=".$c3->toTeX().
"}^{".$c4->toTeX()."} ".$c1->toTeX();
}
when ("limit") {
if (scalar(@children) < 4) {
return "\\lim ".$c1->toTeX();
} elsif (scalar(@children) == 4) {
return "\\lim_{".$c2->toTeX()." \\to ".$c3->toTeX().
"}".$c1->toTeX();
} else {
return "\\lim_{".$c2->toTeX()." \\to ".$c3->toTeX().
(($c4->value eq "plus") ? "+" : "-").
"}".$c1->toTeX();
}
}
when ("binomial") {
return "\\binom{".$c1->toTeX()."}{".$c2->toTeX()."}";
}
when (["union","intersection"]) {
if (!defined $children[2]) {
die CalcException->new("Missing parameter for function [_1].", $fname);
}
if ($c1->type != SET && $c1->type != INTERVAL && $c1->type != FUNCTION) {
die CalcException->new("Wrong type for function [_1] (should be a set or interval).", $fname);
}
if ($fname eq "union") {
return $c1->toTeX().' \cup '.$c2->toTeX();
} else {
return $c1->toTeX().' \cap '.$c2->toTeX();
}
}
when ("sin") { return "\\sin ".$c1->toTeX(); }
when ("cos") { return "\\cos ".$c1->toTeX(); }
when ("tan") { return "\\tan ".$c1->toTeX(); }
when ("asin") { return "\\arcsin ".$c1->toTeX(); }
when ("acos") { return "\\arccos ".$c1->toTeX(); }
when ("atan") { return "\\arctan ".$c1->toTeX(); }
when ("sinh") { return "\\sinh ".$c1->toTeX(); }
when ("cosh") { return "\\cosh ".$c1->toTeX(); }
when ("tanh") { return "\\tanh ".$c1->toTeX(); }
default {
my $s = $fname."(";
for (my $i=1; $i<scalar(@children); $i++) {
if ($i != 1) {
$s .= ", ";
}
$s .= $children[$i]->toTeX();
}
$s .= ")";
return($s);
}
}
}
when (VECTOR) {
my @children = @{$self->children};
# my $s = "\\begin{pmatrix}";
# NOTE: pmatrix would be easier, but tth does not recognize it
my $col;
if (scalar(@children) == 0) {
$col = 0;
} elsif ($children[0]->type == VECTOR) {
$col = scalar(@{$children[0]->children});
} else {
$col = 1;
}
my $s = "\\left( \\begin{array}{".('c' x $col)."}";
for (my $i=0; $i<scalar(@children); $i++) {
if ($i != 0) {
$s .= " \\\\ ";
}
if ($children[0]->type == VECTOR) {
# matrix
for (my $j=0; $j<scalar(@{$children[$i]->children}); $j++) {
if ($j != 0) {
$s .= " & ";
}
$s .= $children[$i]->children->[$j]->toTeX();
}
} else {
# vector
$s .= $children[$i]->toTeX();
}
}
# $s .= "\\end{pmatrix}";
$s .= "\\end{array} \\right)";
return($s);
}
when (INTERVAL) {
my @children = @{$self->children};
if (scalar(@children) != 2) {
die CalcException->new("Interval should have two parameters.");
}
my ($qminopen, $qmaxopen);
given ($self->interval_type) {
when (OPEN_OPEN) { $qminopen = 1; $qmaxopen = 1; }
when (OPEN_CLOSED) { $qminopen = 1; $qmaxopen = 0; }
when (CLOSED_OPEN) { $qminopen = 0; $qmaxopen = 1; }
when (CLOSED_CLOSED) { $qminopen = 0; $qmaxopen = 0; }
}
my $s = "\\left";
if ($qminopen) {
$s .= "(";
} else {
$s .= "[";
}
$s .= $children[0]->toTeX();
$s .= ", ";
$s .= $children[1]->toTeX();
$s .= "\\right";
if ($qmaxopen) {
$s .= ")";
} else {
$s .= "]";
}
return($s);
}
when (SET) {
my @children = @{$self->children};
my $s = "\\left\\{ {";
for (my $i=0; $i<scalar(@children); $i++) {
if ($i != 0) {
$s .= ", ";
}
$s .= $children[$i]->toTeX();
}
$s .= "}\\right\\}";
return($s);
}
when (SUBSCRIPT) {
my @children = @{$self->children};
return($children[0]->toTeX()."_{".$children[1]->toTeX()."}");
}
}
}
##
# Creates a vector or a matrix with this node
# @param {CalcEnv} env - Calculation environment.
# @returns {QVector|QMatrix}
##
sub createVectorOrMatrix {
my ( $self, $env ) = @_;
my @children = @{$self->children};
my @t = (); # 1d or 2d array of Quantity
my $start;
if ($self->type == FUNCTION) {
$start = 1;
} else {
$start = 0;
}
my $nb1;
for (my $i=0; $i < scalar(@children) - $start; $i++) {
my $qv = $children[$i+$start]->calc($env);
my $nb2;
if ($qv->isa(Quantity)) {
$nb2 = 1;
} else {
$nb2 = scalar(@{$qv->quantities});
}
if (!defined $nb1) {
$nb1 = $nb2;
} elsif ($nb2 != $nb1) {
die CalcException->new("Inconsistent number of elements in a matrix.");
}
if ($qv->isa(Quantity)) {
$t[$i] = $qv;
} else {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$qv->quantities}); $j++) {
$t[$i][$j] = $qv->quantities->[$j];
}
}
}
if (ref($t[0]) eq 'ARRAY') {
return QMatrix->new(\@t);
} else {
return QVector->new(\@t);
}
}
1;
__END__
Index: loncom/homework/math_parser/Operator.pm
+++ loncom/homework/math_parser/Operator.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Parser operator
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Parser operator, like "(".
##
package Apache::math_parser::Operator;
use strict;
use warnings;
use utf8;
use enum qw(UNKNOWN UNARY BINARY TERNARY);
##
# Constructor
# @param {string} id - Characters used to recognize the operator
# @param {integer} arity (Operator::UNKNOWN, UNARY, BINARY, TERNARY)
# @param {integer} lbp - left binding power
# @param {integer} rbp - right binding power
# @param {nudFunction} nud - Null denotation function. Parameters: Parser p. Returns: ENode.
# @param {ledFunction} led - Left denotation function Parameters: Parser p, ENode left. Returns: ENode.
##
sub new {
my $class = shift;
my $self = {
_id => shift,
_arity => shift,
_lbp => shift,
_rbp => shift,
_nud => shift,
_led => shift,
};
bless $self, $class;
return $self;
}
# Attribute helpers
sub id {
my $self = shift;
return $self->{_id};
}
sub arity {
my $self = shift;
return $self->{_arity};
}
sub lbp {
my $self = shift;
return $self->{_lbp};
}
sub rbp {
my $self = shift;
return $self->{_rbp};
}
sub nud {
my $self = shift;
return $self->{_nud};
}
sub led {
my $self = shift;
return $self->{_led};
}
1;
__END__
Index: loncom/homework/math_parser/ParseException.pm
+++ loncom/homework/math_parser/ParseException.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Parse exception
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Parse exception
##
package Apache::math_parser::ParseException;
use strict;
use warnings;
use utf8;
use Apache::lonlocal;
use overload '""' => \&toString;
##
# Constructor
# @param {string} msg - error message, using [_1] for the first parameter
# @param {integer} from - Character index
# @optional {string} to - Character index to (inclusive)
# @optional {...string} param - parameters for the message
##
sub new {
my $class = shift;
my $self = {
_msg => shift,
_from => shift,
_to => shift,
_params => [],
};
while (@_) {
push(@{$self->{_params}}, shift);
}
if (! defined $self->{_to}) {
$self->{_to} = $self->{_from};
}
bless $self, $class;
return $self;
}
# Attribute helpers
sub msg {
my $self = shift;
return $self->{_msg};
}
sub from {
my $self = shift;
return $self->{_from};
}
sub to {
my $self = shift;
return $self->{_to};
}
sub params {
my $self = shift;
return $self->{_params};
}
##
# Returns the exception as a string, for debug only.
# @returns {string}
##
sub toString {
my $self = shift;
my $s = "Parsing error: ".$self->msg." at ".$self->from." - ".$self->to;
if (scalar(@{$self->params}) > 0) {
$s .= ", ".join(", ", @{$self->params});
}
return $s;
}
##
# Returns the error message localized for the user interface.
# @returns {string}
##
sub getLocalizedMessage {
my $self = shift;
return mt($self->msg, @{$self->params});
}
1;
__END__
Index: loncom/homework/math_parser/Parser.pm
+++ loncom/homework/math_parser/Parser.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Parser
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Equation parser
##
package Apache::math_parser::Parser;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::Definitions';
use aliased 'Apache::math_parser::ENode';
use aliased 'Apache::math_parser::Operator';
use aliased 'Apache::math_parser::ParseException';
use aliased 'Apache::math_parser::Token';
use aliased 'Apache::math_parser::Tokenizer';
##
# Constructor
# @optional {boolean} implicit_operators - assume hidden multiplication and unit operators in some cases (unlike maxima)
# @optional {boolean} unit_mode - handle only numerical expressions with units (no variable)
##
sub new {
my $class = shift;
my $self = {
_implicit_operators => shift // 0,
_unit_mode => shift // 0,
_defs => Definitions->new(),
};
$self->{_defs}->define();
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Implicit operators ?
# @returns {boolean}
##
sub implicit_operators {
my $self = shift;
return $self->{_implicit_operators};
}
##
# Unit mode ?
# @returns {boolean}
##
sub unit_mode {
my $self = shift;
return $self->{_unit_mode};
}
##
# Definitions
# @returns {Definitions}
##
sub defs {
my $self = shift;
return $self->{_defs};
}
##
# Tokens
# @returns {Token[]}
##
sub tokens {
my $self = shift;
return $self->{_tokens};
}
##
# Current token
# @returns {Token}
##
sub current_token {
my $self = shift;
return $self->{_current_token};
}
##
# Current token number
# @returns {int}
##
sub token_nr {
my $self = shift;
return $self->{_token_nr};
}
##
# Returns the right node at the current token, based on top-down operator precedence.
# @param {integer} rbp - Right binding power
# @returns {ENode}
##
sub expression {
my( $self, $rbp ) = @_;
my $left; # ENode
my $t = $self->current_token;
if (! defined $t) {
die ParseException->new("Expected something at the end.",
$self->tokens->[scalar(@{$self->tokens}) - 1]->to + 1);
}
$self->advance();
if (! defined $t->op) {
$left = ENode->new($t->type, undef, $t->value, undef);
} elsif (! defined $t->op->nud) {
die ParseException->new("Unexpected operator '[_1]'.", $t->from, $t->from, $t->op->id);
} else {
$left = $t->op->nud->($t->op, $self);
}
while (defined $self->current_token && defined $self->current_token->op &&
$rbp < $self->current_token->op->lbp) {
$t = $self->current_token;
$self->advance();
$left = $t->op->led->($t->op, $self, $left);
}
return $left;
}
##
# Advance to the next token,
# expecting the given operator id if it is provided.
# Throws a ParseException if a given operator id is not found.
# @optional {string} id - Operator id
##
sub advance {
my ( $self, $id ) = @_;
if (defined $id && (!defined $self->current_token || !defined $self->current_token->op ||
$self->current_token->op->id ne $id)) {
if (!defined $self->current_token) {
die ParseException->new("Expected '[_1]' at the end.",
$self->tokens->[scalar(@{$self->tokens}) - 1]->to + 1, undef, $id);
} else {
die ParseException->new("Expected '[_1]'.", $self->current_token->from, undef, $id);
}
}
if ($self->token_nr >= scalar(@{$self->tokens})) {
$self->{_current_token} = undef;
return;
}
$self->{_current_token} = $self->tokens->[$self->token_nr];
$self->{_token_nr} += 1;
}
##
# Adds hidden multiplication and unit operators to the token stream
##
sub addHiddenOperators {
my ( $self ) = @_;
my $multiplication = $self->defs->findOperator("*");
my $unit_operator = $self->defs->findOperator("`");
my $in_units = 0; # we check if we are already in the units to avoid adding two ` operators inside
my $in_exp = 0;
for (my $i=0; $i<scalar(@{$self->tokens}) - 1; $i++) {
my $token = $self->tokens->[$i];
my $next_token = $self->tokens->[$i + 1];
if ($self->unit_mode) {
if ($token->value eq "`") {
$in_units = 1;
} elsif ($in_units) {
if ($token->value eq "^") {
$in_exp = 1;
} elsif ($in_exp && $token->type == Token->NUMBER) {
$in_exp = 0;
} elsif (!$in_exp && $token->type == Token->NUMBER) {
$in_units = 0;
} elsif (!$in_exp && $token->type == Token->OPERATOR && index("*/^()", $token->value) == -1) {
$in_units = 0;
} elsif ($token->type == Token->NAME && $next_token->value eq "(") {
$in_units = 0;
}
}
}
my $token_type = $token->type;
my $next_token_type = $next_token->type;
my $token_value = $token->value;
my $next_token_value = $next_token->value;
if (
($token_type == Token->NAME && $next_token_type == Token->NAME) ||
($token_type == Token->NUMBER && $next_token_type == Token->NAME) ||
($token_type == Token->NUMBER && $next_token_type == Token->NUMBER) ||
($token_type == Token->NUMBER && $next_token_value ~~ ["(","[","{"]) ||
# ($token_type == Token->NAME && $next_token_value eq "(") ||
# name ( could be a function call
($token_value ~~ [")","]","}"] && $next_token_type == Token->NAME) ||
($token_value ~~ [")","]","}"] && $next_token_type == Token->NUMBER) ||
($token_value ~~ [")","]","}"] && $next_token_value eq "(")
) {
# support for things like "(1/2) (m/s)" is complex...
my $units = ($self->unit_mode && !$in_units &&
($token_type == Token->NUMBER || $token_value ~~ [")","]","}"]) &&
($next_token_type == Token->NAME ||
($next_token_value ~~ ["(","[","{"] && scalar(@{$self->tokens}) > $i + 2 &&
$self->tokens->[$i + 2]->type == Token->NAME)));
if ($units) {
my( $test_token, $index_test);
if ($next_token_type == Token->NAME) {
$test_token = $next_token;
$index_test = $i + 1;
} else {
# for instance for "2 (m/s)"
$index_test = $i + 2;
$test_token = $self->tokens->[$index_test];
}
if (scalar(@{$self->tokens}) > $index_test + 1 && $self->tokens->[$index_test + 1]->value eq "(") {
my @known_functions = ("pow", "sqrt", "abs", "exp", "factorial", "diff",
"integrate", "sum", "product", "limit", "binomial", "matrix",
"ln", "log", "log10", "mod", "sgn", "ceil", "floor",
"sin", "cos", "tan", "asin", "acos", "atan", "atan2",
"sinh", "cosh", "tanh", "asinh", "acosh", "atanh");
for (my $j=0; $j<scalar(@known_functions); $j++) {
if ($test_token->value eq $known_functions[$j]) {
$units = 0;
last;
}
}
}
}
my $new_token;
if ($units) {
$new_token = Token->new(Token->OPERATOR, $next_token->from,
$next_token->from, $unit_operator->id, $unit_operator);
} else {
$new_token = Token->new(Token->OPERATOR, $next_token->from,
$next_token->from, $multiplication->id, $multiplication);
}
splice(@{$self->{_tokens}}, $i+1, 0, $new_token);
}
}
}
##
# Parse the string, returning an ENode tree.
# @param {string} text - The text to parse.
# @returns {ENode}
##
sub parse {
my ( $self, $text ) = @_;
my $tokenizer = Tokenizer->new($self->defs, $text);
@{$self->{_tokens}} = $tokenizer->tokenize();
if (scalar(@{$self->tokens}) == 0) {
die ParseException->new("No information found.");
}
if ($self->implicit_operators) {
$self->addHiddenOperators();
}
$self->{_token_nr} = 0;
$self->{_current_token} = $self->tokens->[$self->token_nr];
$self->advance();
my $root = $self->expression(0);
if (defined $self->current_token) {
die ParseException->new("Expected the end.", $self->current_token->from);
}
return $root;
}
1;
__END__
Index: loncom/homework/math_parser/QInterval.pm
+++ loncom/homework/math_parser/QInterval.pm
# The LearningOnline Network with CAPA - LON-CAPA
# QInterval
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# An interval of quantities
##
package Apache::math_parser::QInterval;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QInterval';
use aliased 'Apache::math_parser::QIntervalUnion';
use overload
'""' => \&toString,
'+' => \&union,
'*' => \&qmult;
##
# Constructor
# @param {Quantity} qmin - quantity min
# @param {Quantity} qmax - quantity max
# @param {boolean} qminopen - qmin open ?
# @param {boolean} qmaxopen - qmax open ?
##
sub new {
my $class = shift;
my $self = {
_qmin => shift,
_qmax => shift,
_qminopen => shift,
_qmaxopen => shift,
};
bless $self, $class;
my %units = %{$self->qmin->units};
foreach my $unit (keys %units) {
if ($units{$unit} != $self->qmax->units->{$unit}) {
die CalcException->new("Interval creation: different units are used for the two endpoints.");
}
}
if ($self->qmin > $self->qmax) {
die CalcException->new("Interval creation: lower limit greater than upper limit.");
}
return $self;
}
# Attribute helpers
##
# Min quantity.
# @returns {Quantity}
##
sub qmin {
my $self = shift;
return $self->{_qmin};
}
##
# Max quantity.
# @returns {Quantity}
##
sub qmax {
my $self = shift;
return $self->{_qmax};
}
##
# Returns 1 if the interval minimum is open, 0 otherwise.
# @returns {boolean}
##
sub qminopen {
my $self = shift;
return $self->{_qminopen};
}
##
# Returns 1 if the interval maximum is open, 0 otherwise.
# @returns {boolean}
##
sub qmaxopen {
my $self = shift;
return $self->{_qmaxopen};
}
##
# Returns 1 if the interval is empty
# @returns {boolean}
##
sub is_empty {
my ( $self ) = @_;
if ($self->qmin->value == $self->qmax->value && $self->qminopen && $self->qmaxopen) {
return(1);
}
return(0);
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s;
if ($self->qminopen) {
$s = '(';
} else {
$s = '[';
}
$s .= $self->qmin->toString();
$s .= " : ";
$s .= $self->qmax->toString();
if ($self->qmaxopen) {
$s .= ')';
} else {
$s .= ']';
}
return $s;
}
##
# Equality test
# @param {QInterval} inter
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $inter, $tolerance ) = @_;
if (!$inter->isa(QInterval)) {
return 0;
}
if ($self->is_empty() && $inter->is_empty()) {
return 1;
}
if (!$self->qmin->equals($inter->qmin, $tolerance)) {
return 0;
}
if (!$self->qmax->equals($inter->qmax, $tolerance)) {
return 0;
}
if (!$self->qminopen == $inter->qminopen) {
return 0;
}
if (!$self->qmaxopen == $inter->qmaxopen) {
return 0;
}
return 1;
}
##
# Compare this vector with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QInterval.
# @param {QInterval|QSet|Quantity|QVector|QMatrix} inter
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|WRONG_ENDPOINT|IDENTICAL
##
sub compare {
my ( $self, $inter, $tolerance ) = @_;
if (!$inter->isa(QInterval)) {
return Quantity->WRONG_TYPE;
}
my @codes = ();
push(@codes, $self->qmin->compare($inter->qmin, $tolerance));
push(@codes, $self->qmax->compare($inter->qmax, $tolerance));
my @test_order = (Quantity->WRONG_TYPE, Quantity->WRONG_DIMENSIONS, Quantity->MISSING_UNITS, Quantity->ADDED_UNITS,
Quantity->WRONG_UNITS, Quantity->WRONG_VALUE);
foreach my $test (@test_order) {
foreach my $code (@codes) {
if ($code == $test) {
return $test;
}
}
}
if ($self->qminopen != $inter->qminopen) {
return Quantity->WRONG_ENDPOINT;
}
if ($self->qmaxopen != $inter->qmaxopen) {
return Quantity->WRONG_ENDPOINT;
}
return Quantity->IDENTICAL;
}
##
# Clone this object.
# @returns {QInterval}
##
sub clone {
my ( $self ) = @_;
return QInterval->new($self->qmin->clone(), $self->qmax->clone(), $self->qminopen, $self->qmaxopen);
}
##
# Tests if this interval contains a quantity.
# @param {Quantity} q
# @returns {boolean}
##
sub contains {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Interval contains: second member is not a quantity.");
}
if (!$self->qminopen && $self->qmin->equals($q)) {
return 1;
}
if (!$self->qmaxopen && $self->qmax->equals($q)) {
return 1;
}
if ($self->qmin < $q && $self->qmax > $q) {
return 1;
}
return 0;
}
##
# Multiplication by a Quantity
# @param {Quantity} q
# @returns {QInterval}
##
sub qmult {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Interval multiplication: second member is not a quantity.");
}
return QInterval->new($self->qmin * $q, $self->qmax * $q, $self->qminopen, $self->qmaxopen);
}
##
# Union
# @param {QInterval|QIntervalUnion} inter
# @returns {QInterval|QIntervalUnion}
##
sub union {
my ( $self, $inter ) = @_;
if (!$inter->isa(QInterval) && !$inter->isa(QIntervalUnion)) {
die CalcException->new("Interval union: second member is not an interval or an interval union.");
}
if ($inter->isa(QIntervalUnion)) {
return($inter->union($self));
}
my %units = %{$self->qmin->units};
foreach my $unit (keys %units) {
if ($units{$unit} != $inter->qmin->units->{$unit}) {
die CalcException->new("Interval union: different units are used in the two intervals.");
}
}
if ($self->qmax->value < $inter->qmin->value || $self->qmin->value > $inter->qmax->value) {
return QIntervalUnion->new([$self, $inter]);
}
if ($self->qmax->equals($inter->qmin) && $self->qmaxopen && $inter->qminopen) {
return QIntervalUnion->new([$self, $inter]);
}
if ($self->qmin->equals($inter->qmax) && $self->qmaxopen && $inter->qminopen) {
return QIntervalUnion->new([$self, $inter]);
}
if ($self->qmin->value == $self->qmax->value && $self->qminopen && $self->qmaxopen) {
# $self is an empty interval
return QInterval->new($inter->qmin, $inter->qmax, $inter->qminopen, $inter->qmaxopen);
}
if ($inter->qmin->value == $inter->qmax->value && $inter->qminopen && $inter->qmaxopen) {
# $inter is an empty interval
return QInterval->new($self->qmin, $self->qmax, $self->qminopen, $self->qmaxopen);
}
my ($qmin, $qminopen);
if ($self->qmin->value == $inter->qmin->value) {
$qmin = $inter->qmin->clone();
$qminopen = $self->qminopen && $inter->qminopen;
} elsif ($self->qmin->value < $inter->qmin->value) {
$qmin = $self->qmin->clone();
$qminopen = $self->qminopen;
} else {
$qmin = $inter->qmin->clone();
$qminopen = $inter->qminopen;
}
my ($qmax, $qmaxopen);
if ($self->qmax->value == $inter->qmax->value) {
$qmax = $self->qmax->clone();
$qmaxopen = $self->qmaxopen && $inter->qmaxopen;
} elsif ($self->qmax->value > $inter->qmax->value) {
$qmax = $self->qmax->clone();
$qmaxopen = $self->qmaxopen;
} else {
$qmax = $inter->qmax->clone();
$qmaxopen = $inter->qmaxopen;
}
return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
}
##
# Intersection
# @param {QInterval|QIntervalUnion} inter
# @returns {QInterval}
##
sub intersection {
my ( $self, $inter ) = @_;
if (!$inter->isa(QInterval) && !$inter->isa(QIntervalUnion)) {
die CalcException->new("Interval intersection: second member is not an interval or an interval union.");
}
if ($inter->isa(QIntervalUnion)) {
return($inter->intersection($self));
}
my %units = %{$self->qmin->units};
foreach my $unit (keys %units) {
if ($units{$unit} != $inter->qmin->units->{$unit}) {
die CalcException->new("Interval intersection: different units are used in the two intervals.");
}
}
if ($self->qmax->value < $inter->qmin->value || $self->qmin->value > $inter->qmax->value) {
return QInterval->new($self->qmin, $self->qmin, 1, 1); # empty interval
}
if ($self->qmax->equals($inter->qmin) && $self->qmaxopen && $inter->qminopen) {
return QInterval->new($self->qmax, $self->qmax, 1, 1); # empty interval
}
if ($self->qmin->equals($inter->qmax) && $self->qmaxopen && $inter->qminopen) {
return QInterval->new($self->qmin, $self->qmin, 1, 1); # empty interval
}
my ($qmin, $qminopen);
if ($self->qmin->value == $inter->qmin->value) {
$qmin = $self->qmin->clone();
$qminopen = $self->qminopen || $inter->qminopen;
} elsif ($self->qmin->value < $inter->qmin->value) {
$qmin = $inter->qmin->clone();
$qminopen = $inter->qminopen;
} else {
$qmin = $self->qmin->clone();
$qminopen = $self->qminopen;
}
my ($qmax, $qmaxopen);
if ($self->qmax->value == $inter->qmax->value) {
$qmax = $self->qmax->clone();
$qmaxopen = $self->qmaxopen || $inter->qmaxopen;
} elsif ($self->qmax->value > $inter->qmax->value) {
$qmax = $inter->qmax->clone();
$qmaxopen = $inter->qmaxopen;
} else {
$qmax = $self->qmax->clone();
$qmaxopen = $self->qmaxopen;
}
return QInterval->new($qmin, $qmax, $qminopen, $qmaxopen);
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} inter
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $inter, $tolerance ) = @_;
my $q = $self->equals($inter, $tolerance);
return Quantity->new($q);
}
1;
__END__
Index: loncom/homework/math_parser/QIntervalUnion.pm
+++ loncom/homework/math_parser/QIntervalUnion.pm
# The LearningOnline Network with CAPA - LON-CAPA
# QIntervalUnion
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A union of possibly disjoint intervals
##
package Apache::math_parser::QIntervalUnion;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QInterval';
use aliased 'Apache::math_parser::QIntervalUnion';
use overload
'""' => \&toString,
'+' => \&union,
'*' => \&qmult;
##
# Constructor
# @param {QInterval[]} intervals
##
sub new {
my $class = shift;
# we use an array to preserve order (of course purely for cosmetic reasons)
my $self = {
_intervals => shift,
};
bless $self, $class;
# sanity checks
foreach my $inter (@{$self->intervals}) {
if (!$inter->isa(QInterval)) {
die CalcException->new("All components of the union must be intervals.");
}
}
if (scalar(@{$self->intervals}) > 0) {
my %units = %{$self->intervals->[0]->qmin->units};
for (my $i=1; $i < scalar(@{$self->intervals}); $i++) {
my $inter = $self->intervals->[$i];
foreach my $unit (keys %units) {
if ($units{$unit} != $inter->qmin->units->{$unit}) {
die CalcException->new("Different units are used in the intervals.");
}
}
}
}
# clone the intervals so that they can be modified independantly
for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
$self->intervals->[$i] = $self->intervals->[$i]->clone();
}
# reduction to make comparisons easier
$self->reduce();
return $self;
}
# Attribute helpers
##
# The intervals in the interval union, in canonical form (sorted disjoint intervals)
# @returns {QInterval[]}
##
sub intervals {
my $self = shift;
return $self->{_intervals};
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s = '(';
for (my $i=0; $i < scalar(@{$self->intervals}); $i++) {
$s .= $self->intervals->[$i]->toString();
if ($i != scalar(@{$self->intervals}) - 1) {
$s .= "+";
}
}
$s .= ')';
return $s;
}
##
# Equality test
# @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $qiu, $tolerance ) = @_;
if (!$qiu->isa(QIntervalUnion)) {
return 0;
}
if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
return 0;
}
foreach my $inter1 (@{$self->intervals}) {
my $found = 0;
foreach my $inter2 (@{$qiu->intervals}) {
if ($inter1->equals($inter2, $tolerance)) {
$found = 1;
last;
}
}
if (!$found) {
return 0;
}
}
return 1;
}
##
# Compare this interval union with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QIntervalUnion
# (this might happen if a union of disjoint intervals is compared with a simple interval).
# @param {QIntervalUnion|QInterval|QSet|Quantity|QVector|QMatrix} qui
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|WRONG_ENDPOINT|IDENTICAL
##
sub compare {
my ( $self, $qiu, $tolerance ) = @_;
if (!$qiu->isa(QIntervalUnion)) {
return Quantity->WRONG_TYPE;
}
if (scalar(@{$self->intervals}) != scalar(@{$qiu->intervals})) {
return Quantity->WRONG_DIMENSIONS;
}
my @codes = ();
foreach my $inter1 (@{$self->intervals}) {
my $best_code = Quantity->WRONG_TYPE;
foreach my $inter2 (@{$qiu->intervals}) {
my $code = $inter1->compare($inter2, $tolerance);
if ($code == Quantity->IDENTICAL) {
$best_code = $code;
last;
} elsif ($code > $best_code) {
$best_code = $code;
}
}
if ($best_code != Quantity->IDENTICAL) {
return $best_code;
}
}
return Quantity->IDENTICAL;
}
##
# Turns the internal structure into canonical form (sorted disjoint intervals)
##
sub reduce {
my ( $self ) = @_;
my @intervals = @{$self->intervals}; # shallow copy (just to make the code easier to read)
# remove empty intervals
for (my $i=0; $i < scalar(@intervals); $i++) {
my $inter = $intervals[$i];
if ($inter->qmin->value == $inter->qmax->value && $inter->qminopen && $inter->qmaxopen) {
splice(@intervals, $i, 1);
$i--;
}
}
# unite intervals that are not disjoint
# (at this point we already know that units are the same, and there is no empty interval)
for (my $i=0; $i < scalar(@intervals); $i++) {
my $inter1 = $intervals[$i];
for (my $j=$i+1; $j < scalar(@intervals); $j++) {
my $inter2 = $intervals[$j];
if ($inter1->qmax->value < $inter2->qmin->value || $inter1->qmin->value > $inter2->qmax->value) {
next;
}
if ($inter1->qmax->equals($inter2->qmin) && $inter1->qmaxopen && $inter2->qminopen) {
next;
}
if ($inter1->qmin->equals($inter2->qmax) && $inter1->qmaxopen && $inter2->qminopen) {
next;
}
$intervals[$i] = $inter1->union($inter2);
splice(@intervals, $j, 1);
$i--;
last;
}
}
# sort the intervals
for (my $i=0; $i < scalar(@intervals); $i++) {
my $inter1 = $intervals[$i];
for (my $j=$i+1; $j < scalar(@intervals); $j++) {
my $inter2 = $intervals[$j];
if ($inter1->qmin > $inter2->qmin) {
$intervals[$i] = $inter2;
$intervals[$j] = $inter1;
$inter1 = $intervals[$i];
$inter2 = $intervals[$j];
}
}
}
$self->{_intervals} = \@intervals;
}
##
# Tests if this union of intervals contains a quantity.
# @param {Quantity} q
# @returns {boolean}
##
sub contains {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Second member of an interval is not a quantity.");
}
foreach my $inter (@{$self->intervals}) {
if ($inter->contains($q)) {
return 1;
}
}
return 0;
}
##
# Multiplication by a Quantity
# @param {Quantity} q
# @returns {QIntervalUnion}
##
sub qmult {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Intervals can only be multiplied by quantities.");
}
my @t = ();
foreach my $inter (@{$self->intervals}) {
push(@t, $inter * $q);
}
return QIntervalUnion->new(\@t);
}
##
# Union
# @param {QIntervalUnion|QInterval} qui
# @returns {QIntervalUnion|QInterval}
##
sub union {
my ( $self, $qiu ) = @_;
if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
die CalcException->new("Cannot form a union if second member is not an interval union or an interval.");
}
my @t = ();
foreach my $inter (@{$self->intervals}) {
push(@t, $inter->clone());
}
if ($qiu->isa(QInterval)) {
push(@t, $qiu->clone());
} else {
foreach my $inter (@{$qiu->intervals}) {
push(@t, $inter->clone());
}
}
my $new_union = QIntervalUnion->new(\@t); # will be reduced in the constructor
if (scalar(@{$new_union->intervals}) == 1) {
return $new_union->intervals->[0];
}
return $new_union;
}
##
# Intersection
# @param {QIntervalUnion|QInterval} qui
# @returns {QIntervalUnion|QInterval}
##
sub intersection {
my ( $self, $qiu ) = @_;
if (!$qiu->isa(QIntervalUnion) && !$qiu->isa(QInterval)) {
die CalcException->new("Cannot form an intersection if second member is not an interval union or an interval.");
}
my @t = ();
my $intervals2;
if ($qiu->isa(QInterval)) {
$intervals2 = [$qiu];
} else {
$intervals2 = $qiu->intervals;
}
foreach my $inter1 (@{$self->intervals}) {
foreach my $inter2 (@{$intervals2}) {
my $intersection = $inter1->intersection($inter2);
if (!$intersection->is_empty()) {
push(@t, $intersection);
}
}
}
my $new_qiu = QIntervalUnion->new(\@t);
if (scalar(@{$new_qiu->intervals}) == 1) {
return $new_qiu->intervals->[0];
}
return $new_qiu;
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} qui
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $qui, $tolerance ) = @_;
my $q = $self->equals($qui, $tolerance);
return Quantity->new($q);
}
1;
__END__
Index: loncom/homework/math_parser/QMatrix.pm
+++ loncom/homework/math_parser/QMatrix.pm
# The LearningOnline Network with CAPA - LON-CAPA
# QMatrix
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A matrix of quantities
##
package Apache::math_parser::QMatrix;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QVector';
use aliased 'Apache::math_parser::QMatrix';
use overload
'""' => \&toString,
'+' => \&qadd,
'-' => \&qsub,
'*' => \&qmult,
'/' => \&qdiv,
'^' => \&qpow;
##
# Constructor
# @param {Quantity[][]} quantities
##
sub new {
my $class = shift;
my $self = {
_quantities => shift,
};
bless $self, $class;
return $self;
}
# Attribute helpers
##
# The components of the matrix.
# @returns {Quantity[][]}
##
sub quantities {
my $self = shift;
return $self->{_quantities};
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s = "[";
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$s .= "[";
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$s .= $self->quantities->[$i][$j]->toString();
if ($j != scalar(@{$self->quantities->[$i]}) - 1) {
$s .= "; ";
}
}
$s .= "]";
if ($i != scalar(@{$self->quantities}) - 1) {
$s .= "; ";
}
}
$s .= "]";
return $s;
}
##
# Equality test
# @param {QMatrix} m
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $m, $tolerance ) = @_;
if (!$m->isa(QMatrix)) {
return 0;
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
return 0;
}
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
if (scalar(@{$self->quantities->[$i]}) != scalar(@{$m->quantities->[$i]})) {
return 0;
}
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
if (!$self->quantities->[$i][$j]->equals($m->quantities->[$i][$j], $tolerance)) {
return 0;
}
}
}
return 1;
}
##
# Compare this matrix with another one, and returns a code.
# @param {Quantity|QVector|QMatrix|QSet|QInterval} m
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
##
sub compare {
my ( $self, $m, $tolerance ) = @_;
if (!$m->isa(QMatrix)) {
return Quantity->WRONG_TYPE;
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
return Quantity->WRONG_DIMENSIONS;
}
my @codes = ();
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
if (scalar(@{$self->quantities->[$i]}) != scalar(@{$m->quantities->[$i]})) {
return Quantity->WRONG_DIMENSIONS;
}
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
push(@codes, $self->quantities->[$i][$j]->compare($m->quantities->[$i][$j], $tolerance));
}
}
my @test_order = (Quantity->WRONG_TYPE, Quantity->WRONG_DIMENSIONS, Quantity->MISSING_UNITS, Quantity->ADDED_UNITS,
Quantity->WRONG_UNITS, Quantity->WRONG_VALUE);
foreach my $test (@test_order) {
foreach my $code (@codes) {
if ($code == $test) {
return $test;
}
}
}
return Quantity->IDENTICAL;
}
##
# Addition
# @param {QMatrix} m
# @returns {QMatrix}
##
sub qadd {
my ( $self, $m ) = @_;
if (!$m->isa(QMatrix)) {
die CalcException->new("Matrix addition: second member is not a matrix.");
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) ||
scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
die CalcException->new("Matrix addition: the matrices have different sizes.");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] + $m->quantities->[$i][$j];
}
}
return QMatrix->new(\@t);
}
##
# Substraction
# @param {QMatrix} m
# @returns {QMatrix}
##
sub qsub {
my ( $self, $m ) = @_;
if (!$m->isa(QMatrix)) {
die CalcException->new("Matrix substraction: second member is not a matrix.");
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) ||
scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
die CalcException->new("Matrix substraction: the matrices have different sizes.");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] - $m->quantities->[$i][$j];
}
}
return QMatrix->new(\@t);
}
##
# Negation
# @returns {QMatrix}
##
sub qneg {
my ( $self ) = @_;
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j]->qneg();
}
}
return QMatrix->new(\@t);
}
##
# Element-by-element multiplication by a quantity, vector or matrix (like Maxima)
# @param {Quantity|QVector|QMatrix} m
# @returns {QMatrix}
##
sub qmult {
my ( $self, $m ) = @_;
if (!$m->isa(Quantity) && !$m->isa(QVector) && !$m->isa(QMatrix)) {
die CalcException->new("Matrix element-by-element multiplication: second member is not a quantity, vector or matrix.");
}
if ($m->isa(Quantity)) {
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] * $m;
}
}
return QMatrix->new(\@t);
}
if ($m->isa(QVector)) {
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
die CalcException->new(
"Matrix-Vector element-by-element multiplication: the sizes do not match (use the dot product for matrix product).");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] * $m->quantities->[$i];
}
}
return QMatrix->new(\@t);
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) ||
scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
die CalcException->new(
"Matrix element-by-element multiplication: the matrices have different sizes (use the dot product for matrix product).");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] * $m->quantities->[$i][$j];
}
}
return QMatrix->new(\@t);
}
##
# Element-by-element division by a quantity, vector or matrix (like Maxima)
# @param {Quantity|QVector|QMatrix} m
# @returns {QMatrix}
##
sub qdiv {
my ( $self, $m ) = @_;
if (!$m->isa(Quantity) && !$m->isa(QVector) && !$m->isa(QMatrix)) {
die CalcException->new("Matrix element-by-element division: second member is not a quantity, vector or matrix.");
}
if ($m->isa(Quantity)) {
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] / $m;
}
}
return QMatrix->new(\@t);
}
if ($m->isa(QVector)) {
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities})) {
die CalcException->new("Matrix-Vector element-by-element division: the sizes do not match.");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] / $m->quantities->[$i];
}
}
return QMatrix->new(\@t);
}
if (scalar(@{$self->quantities}) != scalar(@{$m->quantities}) ||
scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities->[0]})) {
die CalcException->new("Matrix element-by-element division: the matrices have different sizes.");
}
my @t = (); # 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$self->quantities->[$i]}); $j++) {
$t[$i][$j] = $self->quantities->[$i][$j] / $m->quantities->[$i][$j];
}
}
return QMatrix->new(\@t);
}
##
# Noncommutative multiplication by a vector or matrix
# @param {QVector|QMatrix} m
# @returns {QVector|QMatrix}
##
sub qdot {
my ( $self, $m ) = @_;
if (!$m->isa(QVector) && !$m->isa(QMatrix)) {
die CalcException->new("Matrix product: second member is not a vector or a matrix.");
}
if (scalar(@{$self->quantities->[0]}) != scalar(@{$m->quantities})) {
die CalcException->new("Matrix product: the matrices sizes do not match.");
}
if ($m->isa(QVector)) {
my @t = (); # array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = Quantity->new(0);
for (my $j=0; $j < scalar(@{$m->quantities}); $j++) {
$t[$i] += $self->quantities->[$i][$j] * $m->quantities->[$j];
}
}
return QVector->new(\@t);
}
my @t = (); # array or 2d array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = [];
for (my $j=0; $j < scalar(@{$m->quantities->[0]}); $j++) {
$t[$i][$j] = Quantity->new(0);
for (my $k=0; $k < scalar(@{$m->quantities}); $k++) {
$t[$i][$j] += $self->quantities->[$i][$k] * $m->quantities->[$k][$j];
}
}
}
return QMatrix->new(\@t);
}
##
# Power by a scalar
# @param {Quantity} q
# @returns {QMatrix}
##
sub qpow {
my ( $self, $q ) = @_;
$q->noUnits("Power");
# note: this could be optimized, see "exponentiating by squaring"
my $m = QMatrix->new($self->quantities);
for (my $i=0; $i < $q->value - 1; $i++) {
$m = $m * $self;
}
return $m;
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} m
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $m, $tolerance ) = @_;
my $q = $self->equals($m, $tolerance);
return Quantity->new($q);
}
1;
__END__
Index: loncom/homework/math_parser/QSet.pm
+++ loncom/homework/math_parser/QSet.pm
# The LearningOnline Network with CAPA - LON-CAPA
# QSet
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A set of quantities
##
package Apache::math_parser::QSet;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QSet';
use overload
'""' => \&toString,
'+' => \&union,
'*' => \&qmult;
##
# Constructor
# @param {Quantity[]} quantities
##
sub new {
my $class = shift;
# we use an array to preserve order (of course purely for cosmetic reasons)
my $self = {
_quantities => shift,
};
bless $self, $class;
# remove duplicates
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
my $qi = $self->quantities->[$i];
for (my $j=0; $j < $i; $j++) {
my $qj = $self->quantities->[$j];
if ($qi->equals($qj)) {
splice(@{$self->quantities}, $i, 1);
$i--;
last;
}
}
}
return $self;
}
# Attribute helpers
##
# The components of the set.
# @returns {Quantity[]}
##
sub quantities {
my $self = shift;
return $self->{_quantities};
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s = "{";
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$s .= $self->quantities->[$i]->toString();
if ($i != scalar(@{$self->quantities}) - 1) {
$s .= "; ";
}
}
$s .= "}";
return $s;
}
##
# Equality test
# @param {QSet} set
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $set, $tolerance ) = @_;
if (!$set->isa(QSet)) {
return 0;
}
if (scalar(@{$self->quantities}) != scalar(@{$set->quantities})) {
return 0;
}
foreach my $q1 (@{$self->quantities}) {
my $found = 0;
foreach my $q2 (@{$set->quantities}) {
if ($q1->equals($q2, $tolerance)) {
$found = 1;
last;
}
}
if (!$found) {
return 0;
}
}
return 1;
}
##
# Compare this set with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QSet.
# @param {QSet|QInterval|Quantity|QVector|QMatrix} set
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
##
sub compare {
my ( $self, $set, $tolerance ) = @_;
if (!$set->isa(QSet)) {
return Quantity->WRONG_TYPE;
}
if (scalar(@{$self->quantities}) != scalar(@{$set->quantities})) {
return Quantity->WRONG_DIMENSIONS;
}
my @codes = ();
foreach my $q1 (@{$self->quantities}) {
my $best_code = Quantity->WRONG_TYPE;
foreach my $q2 (@{$set->quantities}) {
my $code = $q1->compare($q2, $tolerance);
if ($code == Quantity->IDENTICAL) {
$best_code = $code;
last;
} elsif ($code > $best_code) {
$best_code = $code;
}
}
if ($best_code != Quantity->IDENTICAL) {
return $best_code;
}
}
return Quantity->IDENTICAL;
}
##
# Multiplication by a Quantity
# @param {Quantity} q
# @returns {QSet}
##
sub qmult {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Set multiplication: second member is not a quantity.");
}
my @t = ();
foreach my $sq (@{$self->quantities}) {
push(@t, $sq * $q);
}
return QSet->new(\@t);
}
##
# Union
# @param {QSet} set
# @returns {QSet}
##
sub union {
my ( $self, $set ) = @_;
if (!$set->isa(QSet)) {
die CalcException->new("Set union: second member is not a set.");
}
my @t = @{$self->quantities};
foreach my $q (@{$set->quantities}) {
my $found = 0;
foreach my $q2 (@t) {
if ($q->equals($q2)) {
$found = 1;
last;
}
}
if (!$found) {
push(@t, $q);
}
}
return QSet->new(\@t);
}
##
# Intersection
# @param {QSet} set
# @returns {QSet}
##
sub intersection {
my ( $self, $set ) = @_;
if (!$set->isa(QSet)) {
die CalcException->new("Set intersection: second member is not a set.");
}
my @t = ();
foreach my $q (@{$self->quantities}) {
my $found = 0;
foreach my $q2 (@{$set->quantities}) {
if ($q->equals($q2)) {
$found = 1;
last;
}
}
if ($found) {
push(@t, $q);
}
}
return QSet->new(\@t);
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} set
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $set, $tolerance ) = @_;
my $q = $self->equals($set, $tolerance);
return Quantity->new($q);
}
1;
__END__
Index: loncom/homework/math_parser/QVector.pm
+++ loncom/homework/math_parser/QVector.pm
# The LearningOnline Network with CAPA - LON-CAPA
# QVector
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A vector of quantities
##
package Apache::math_parser::QVector;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QVector';
use overload
'""' => \&toString,
'+' => \&qadd,
'-' => \&qsub,
'*' => \&qmult,
'/' => \&qdiv,
'^' => \&qpow;
##
# Constructor
# @param {Quantity[]} quantities
##
sub new {
my $class = shift;
my $self = {
_quantities => shift,
};
bless $self, $class;
return $self;
}
# Attribute helpers
##
# The components of the vector.
# @returns {Quantity[]}
##
sub quantities {
my $self = shift;
return $self->{_quantities};
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s = "[";
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$s .= $self->quantities->[$i]->toString();
if ($i != scalar(@{$self->quantities}) - 1) {
$s .= "; ";
}
}
$s .= "]";
return $s;
}
##
# Equality test
# @param {QVector} v
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $v, $tolerance ) = @_;
if (!$v->isa(QVector)) {
return 0;
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
return 0;
}
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
if (!$self->quantities->[$i]->equals($v->quantities->[$i], $tolerance)) {
return 0;
}
}
return 1;
}
##
# Compare this vector with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QVector.
# @param {Quantity|QVector|QMatrix|QSet|QInterval} v
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
##
sub compare {
my ( $self, $v, $tolerance ) = @_;
if (!$v->isa(QVector)) {
return Quantity->WRONG_TYPE;
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
return Quantity->WRONG_DIMENSIONS;
}
my @codes = ();
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
push(@codes, $self->quantities->[$i]->compare($v->quantities->[$i], $tolerance));
}
my @test_order = (Quantity->WRONG_TYPE, Quantity->WRONG_DIMENSIONS, Quantity->MISSING_UNITS, Quantity->ADDED_UNITS,
Quantity->WRONG_UNITS, Quantity->WRONG_VALUE);
foreach my $test (@test_order) {
foreach my $code (@codes) {
if ($code == $test) {
return $test;
}
}
}
return Quantity->IDENTICAL;
}
##
# Interprets this vector as an unordered list of quantities, compares it with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a QVector.
# @param {Quantity|QVector|QMatrix|QSet|QInterval} v
# @optional {string|float} tolerance
# @returns {int} Quantity->WRONG_TYPE|WRONG_DIMENSIONS|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
##
sub compare_unordered {
my ( $self, $v, $tolerance ) = @_;
if (!$v->isa(QVector)) {
return Quantity->WRONG_TYPE;
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
return Quantity->WRONG_DIMENSIONS;
}
my @quantities_1 = sort {$a <=> $b} @{$self->quantities};
my $v1 = QVector->new(\@quantities_1);
my @quantities_2 = sort {$a <=> $b} @{$v->quantities};
my $v2 = QVector->new(\@quantities_2);
return($v1->compare($v2, $tolerance));
}
##
# Addition
# @param {QVector} v
# @returns {QVector}
##
sub qadd {
my ( $self, $v ) = @_;
if (!$v->isa(QVector)) {
die CalcException->new("Vector addition: second member is not a vector.");
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
die CalcException->new("Vector addition: the vectors have different sizes.");
}
my @t = (); # array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i] + $v->quantities->[$i];
}
return QVector->new(\@t);
}
##
# Substraction
# @param {QVector} v
# @returns {QVector}
##
sub qsub {
my ( $self, $v ) = @_;
if (!$v->isa(QVector)) {
die CalcException->new("Vector substraction: second member is not a vector.");
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
die CalcException->new("Vector substraction: the vectors have different sizes.");
}
my @t = (); # array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i] - $v->quantities->[$i];
}
return QVector->new(\@t);
}
##
# Negation
# @returns {QVector}
##
sub qneg {
my ( $self ) = @_;
my @t = (); # array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i]->qneg();
}
return QVector->new(\@t);
}
##
# Multiplication by a scalar, or element-by-element multiplication by a vector
# @param {Quantity|QVector} qv
# @returns {QVector}
##
sub qmult {
my ( $self, $qv ) = @_;
if (!$qv->isa(Quantity) && !$qv->isa(QVector)) {
die CalcException->new("Vector multiplication: second member is not a quantity or a vector.");
}
my @t = (); # array of Quantity
if ($qv->isa(Quantity)) {
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i] * $qv;
}
} else {
if (scalar(@{$self->quantities}) != scalar(@{$qv->quantities})) {
die CalcException->new("Vector element-by-element multiplication: the vectors have different sizes.");
}
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i]->qmult($qv->quantities->[$i]);
}
}
return QVector->new(\@t);
}
##
# Division
# @param {Quantity|QVector} qv
# @returns {QVector}
##
sub qdiv {
my ( $self, $qv ) = @_;
if (!$qv->isa(Quantity) && !$qv->isa(QVector)) {
die CalcException->new("Vector division: second member is not a quantity or a vector.");
}
my @t = (); # array of Quantity
if ($qv->isa(Quantity)) {
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i] / $qv;
}
} else {
if (scalar(@{$self->quantities}) != scalar(@{$qv->quantities})) {
die CalcException->new("Vector element-by-element division: the vectors have different sizes.");
}
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i]->qdiv($qv->quantities->[$i]);
}
}
return QVector->new(\@t);
}
##
# Power by a scalar
# @param {Quantity} q
# @returns {QVector}
##
sub qpow {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Vector power: second member is not a quantity.");
}
$q->noUnits("Power");
my @t = (); # array of Quantity
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$t[$i] = $self->quantities->[$i] ^ $q;
}
return QVector->new(\@t);
}
##
# Dot product
# @param {QVector} v
# @returns {Quantity}
##
sub qdot {
my ( $self, $v ) = @_;
if (!$v->isa(QVector)) {
die CalcException->new("Vector dot product: second member is not a vector.");
}
if (scalar(@{$self->quantities}) != scalar(@{$v->quantities})) {
die CalcException->new("Vector dot product: the vectors have different sizes.");
}
my $q = Quantity->new(0);
for (my $i=0; $i < scalar(@{$self->quantities}); $i++) {
$q = $q + $self->quantities->[$i]->qmult($v->quantities->[$i]);
}
return $q;
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} v
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $v, $tolerance ) = @_;
my $q = $self->equals($v, $tolerance);
return Quantity->new($q);
}
1;
__END__
Index: loncom/homework/math_parser/Quantity.pm
+++ loncom/homework/math_parser/Quantity.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Quantity
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A quantity (value and units)
##
package Apache::math_parser::Quantity;
use strict;
use warnings;
use utf8;
use POSIX;
use Math::Complex; # must be after POSIX for redefinition of log10
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Quantity';
use aliased 'Apache::math_parser::QVector';
use aliased 'Apache::math_parser::QMatrix';
use aliased 'Apache::math_parser::QSet';
use aliased 'Apache::math_parser::QInterval';
use aliased 'Apache::math_parser::QIntervalUnion';
use overload
'""' => \&toString,
'+' => \&qadd,
'-' => \&qsub,
'*' => \&qmult,
'/' => \&qdiv,
'^' => \&qpow,
'<' => \&qlt,
'<=' => \&qle,
'>' => \&qgt,
'>=' => \&qge,
'<=>' => \&perl_compare;
# compare() return codes:
use enum qw(IDENTICAL WRONG_TYPE WRONG_DIMENSIONS MISSING_UNITS ADDED_UNITS WRONG_UNITS WRONG_VALUE WRONG_ENDPOINT);
##
# Constructor
# @param {complex} value
# @optional {Object.<string, integer>} units - hash: unit name -> exponent for each SI unit
##
sub new {
my $class = shift;
my $self = {
_value => shift,
_units => shift,
};
if ("".$self->{_value} eq "i") {
$self->{_value} = i;
} elsif ("".$self->{_value} eq "inf") {
$self->{_value} = 9**9**9;
}
if (!defined $self->{_units}) {
$self->{_units} = {
s => 0,
m => 0,
kg => 0,
K => 0,
A => 0,
mol => 0,
cd => 0
};
} else {
foreach my $unit ('s', 'm', 'kg', 'K', 'A', 'mol', 'cd') {
if (!defined $self->{_units}->{$unit}) {
$self->{_units}->{$unit} = 0;
}
}
}
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Value.
# @returns {Complex}
##
sub value {
my $self = shift;
return $self->{_value};
}
##
# Units
# @returns {Object.<string, integer>} hash: unit name -> exponent for each SI unit
##
sub units {
my $self = shift;
return $self->{_units};
}
##
# Returns a readable view of the object
# @returns {string}
##
sub toString {
my ( $self ) = @_;
my $s;
# complex display in polar notation can be confused with vectors
# normally we should just have to call Math::Complex::display_format('cartesian');
# actually, it's supposed to be the default...
# but this is not working, so...
if ($self->value =~ /\[/) {
my $v = $self->value;
$v->display_format('cartesian');
$s = "".$v;
} else {
$s = $self->value;
}
foreach my $unit (keys %{$self->units}) {
my $e = $self->units->{$unit};
if ($e != 0) {
$s .= " ".$unit;
if ($e != 1) {
$s .= "^".$e;
}
}
}
return $s;
}
##
# Equality test
# @param {Quantity}
# @optional {string|float} tolerance
# @returns {boolean}
##
sub equals {
my ( $self, $q, $tolerance ) = @_;
if (!$q->isa(Quantity)) {
return 0;
}
if (!defined $tolerance) {
$tolerance = 0;
}
if ($tolerance =~ /%/) {
my $perc = $tolerance;
$perc =~ s/%//;
$perc /= 100;
if (abs($self->value - $q->value) > abs($self->value * $perc)) {
return 0;
}
} else {
if (abs($self->value - $q->value) > $tolerance) {
return 0;
}
}
my %units = %{$self->units};
foreach my $unit (keys %units) {
if ($units{$unit} != $q->units->{$unit}) {
return 0;
}
}
return 1;
}
##
# Compare this quantity with another one, and returns a code.
# Returns Quantity->WRONG_TYPE if the parameter is not a Quantity.
# @param {Quantity|QVector|QMatrix|QSet|QInterval} q
# @optional {string|float} tolerance
# @returns {int} WRONG_TYPE|MISSING_UNITS|ADDED_UNITS|WRONG_UNITS|WRONG_VALUE|IDENTICAL
##
sub compare {
my ( $self, $q, $tolerance ) = @_;
if (!$q->isa(Quantity)) {
return WRONG_TYPE;
}
if (!defined $tolerance) {
$tolerance = 0;
}
my %units = %{$self->units};
my $this_has_units = 0;
my $other_has_units = 0;
my $wrong_units = 0;
foreach my $unit (keys %units) {
if ($units{$unit} != 0) {
$this_has_units = 1;
}
if ($q->units->{$unit} != 0) {
$other_has_units = 1;
}
if ($units{$unit} != $q->units->{$unit}) {
$wrong_units = 1;
}
}
if ($this_has_units && !$other_has_units) {
return MISSING_UNITS;
} elsif (!$this_has_units && $other_has_units) {
return ADDED_UNITS;
}
if ($wrong_units) {
return WRONG_UNITS;
}
if ($tolerance =~ /%/) {
my $perc = $tolerance;
$perc =~ s/%//;
$perc /= 100;
if (abs($self->value - $q->value) > abs($self->value * $perc)) {
return WRONG_VALUE;
}
} else {
if (abs($self->value - $q->value) > $tolerance) {
return WRONG_VALUE;
}
}
return IDENTICAL;
}
##
# <=> operator.
# Compare this quantity with another one, and returns -1, 0 or 1.
# @param {Quantity} q
# @returns {int}
##
sub perl_compare {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity comparison: second member is not a quantity.");
}
$self->unitsMatch($q, 'perl_compare');
return($self->value <=> $q->value);
}
##
# Not equal
# @param {Quantity} q
# @optional {string|float} tolerance
# @returns {boolean}
##
sub ne {
my ( $self, $q, $tolerance ) = @_;
if ($self->equals($q, $tolerance)) {
return(0);
} else {
return(1);
}
}
##
# Less than
# @param {Quantity} q
# @returns {boolean}
##
sub lt {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity smaller than: second member is not a quantity.");
}
$self->unitsMatch($q, 'lt');
if ($self->value < $q->value) {
return(1);
} else {
return(0);
}
}
##
# Less than or equal
# @param {Quantity} q
# @returns {boolean}
##
sub le {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity smaller or equal: second member is not a quantity.");
}
$self->unitsMatch($q, 'le');
if ($self->value <= $q->value) {
return(1);
} else {
return(0);
}
}
##
# Greater than
# @param {Quantity} q
# @returns {boolean}
##
sub gt {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity greater than: second member is not a quantity.");
}
$self->unitsMatch($q, 'gt');
if ($self->value > $q->value) {
return(1);
} else {
return(0);
}
}
##
# Greater than or equal
# @param {Quantity} q
# @returns {boolean}
##
sub ge {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity greater or equal: second member is not a quantity.");
}
$self->unitsMatch($q, 'ge');
if ($self->value >= $q->value) {
return(1);
} else {
return(0);
}
}
##
# Clone this object
# @returns {Quantity}
##
sub clone {
my ( $self ) = @_;
my %units = %{$self->units};
return Quantity->new($self->value, \%units);
}
##
# Addition
# @param {Quantity} q
# @returns {Quantity}
##
sub qadd {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity addition: second member is not a quantity.");
}
my $v = $self->value + $q->value;
$self->unitsMatch($q, 'addition');
return Quantity->new($v, $self->units);
}
##
# Substraction
# @param {Quantity} q
# @returns {Quantity}
##
sub qsub {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Quantity substraction: second member is not a quantity.");
}
my $v = $self->value - $q->value;
$self->unitsMatch($q, 'substraction');
return Quantity->new($v, $self->units);
}
##
# Negation
# @returns {Quantity}
##
sub qneg {
my ( $self ) = @_;
my $v = - $self->value;
my %units = %{$self->units};
return Quantity->new($v, \%units);
}
##
# Multiplication
# @param {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion} qv
# @returns {Quantity|QVector|QMatrix|QSet|QInterval|QIntervalUnion}
##
sub qmult {
my ( $self, $qv ) = @_;
if (!$qv->isa(Quantity) && !$qv->isa(QVector) && !$qv->isa(QMatrix) &&
!$qv->isa(QSet) && !$qv->isa(QInterval) && !$qv->isa(QIntervalUnion)) {
die CalcException->new("Cannot multiply with something that is not a quantity, vector, matrix, set, or interval.");
}
if ($qv->isa(QVector) || $qv->isa(QMatrix) || $qv->isa(QSet) || $qv->isa(QInterval) || $qv->isa(QIntervalUnion)) {
return($qv->qmult($self));
}
my $q = $qv;
my $v = $self->value * $q->value;
my %units = %{$self->units};
foreach my $unit (keys %units) {
$units{$unit} = $units{$unit} + $q->units->{$unit};
}
return Quantity->new($v, \%units);
}
##
# Division
# @param {Quantity} q
# @returns {Quantity}
##
sub qdiv {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Cannot divide by something that is not a quantity.");
}
if ($q->value == 0) {
die CalcException->new("Division by zero.");
}
my $v = $self->value / $q->value;
my %units = %{$self->units};
foreach my $unit (keys %units) {
$units{$unit} = $units{$unit} - $q->units->{$unit};
}
return Quantity->new($v, \%units);
}
##
# Power
# @param {Quantity} q
# @returns {Quantity}
##
sub qpow {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Cannot raise to the power of something that is not a number.");
}
my $v = $self->value ** $q->value;
$q->noUnits("Power");
my %units = %{$self->units};
foreach my $unit (keys %{$q->units}) {
$units{$unit} = $units{$unit} * $q->value;
}
return Quantity->new($v, \%units);
}
##
# Factorial
# @returns {Quantity}
##
sub qfact {
my ( $self ) = @_;
my $v = $self->value;
if ($v < 0) {
die CalcException->new("Factorial of a number smaller than zero.");
}
# should check if integer
my $n = $v;
for (my $i=$n - 1; $i > 1; $i--) {
$v *= $i;
}
return Quantity->new($v, $self->units);
}
##
# Square root
# @returns {Quantity}
##
sub qsqrt {
my ( $self ) = @_;
my $v = sqrt($self->value);
my %units = %{$self->units};
foreach my $unit (keys %units) {
$units{$unit} = $units{$unit} / 2;
}
return Quantity->new($v, \%units);
}
##
# Absolute value
# @returns {Quantity}
##
sub qabs {
my ( $self ) = @_;
my $v = abs($self->value);
my %units = %{$self->units};
return Quantity->new($v, \%units);
}
##
# Exponential
# @returns {Quantity}
##
sub qexp {
my ( $self ) = @_;
$self->noUnits("exp");
return Quantity->new(exp($self->value), $self->units);
}
##
# Natural logarithm
# @returns {Quantity}
##
sub qln {
my ( $self ) = @_;
$self->noUnits("ln");
# this will return a complex if the value is < 0
#if ($self->value < 0) {
# die CalcException->new("Ln of number < 0");
#}
if ($self->value == 0) {
die CalcException->new("Natural logarithm of zero.");
}
return Quantity->new(log($self->value), $self->units);
}
##
# Decimal logarithm
# @returns {Quantity}
##
sub qlog10 {
my ( $self ) = @_;
$self->noUnits("log10");
# this will return a complex if the value is < 0
#if ($self->value < 0) {
# die CalcException->new("Log10 of number < 0");
#}
if ($self->value == 0) {
die CalcException->new("Logarithm of zero.");
}
return Quantity->new(log10($self->value), $self->units);
}
##
# Modulo
# @param {Quantity} q
# @returns {Quantity}
##
sub qmod {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Cannot calculate the modulus with respect to something that is not a quantity.");
}
my $v = $self->value % $q->value;
return Quantity->new($v, $self->units);
}
##
# Returns -1, 0 or 1 depending on the sign of the value
# @returns {Quantity}
##
sub qsgn {
my ( $self ) = @_;
my $v;
if ($self->value < 0) {
$v = -1;
} elsif ($self->value > 0) {
$v = 1;
} else {
$v = 0;
}
return Quantity->new($v, $self->units);
}
##
# Returns the least integer that is greater than or equal to the value.
# @returns {Quantity}
##
sub qceil {
my ( $self ) = @_;
my $v = ceil($self->value);
return Quantity->new($v, $self->units);
}
##
# Returns the largest integer that is less than or equal to the value.
# @returns {Quantity}
##
sub qfloor {
my ( $self ) = @_;
my $v = floor($self->value);
return Quantity->new($v, $self->units);
}
##
# Sine
# @returns {Quantity}
##
sub qsin {
my ( $self ) = @_;
$self->noUnits("sin");
return Quantity->new(sin($self->value), $self->units);
}
##
# Cosine
# @returns {Quantity}
##
sub qcos {
my ( $self ) = @_;
$self->noUnits("cos");
return Quantity->new(cos($self->value), $self->units);
}
##
# Tangent
# @returns {Quantity}
##
sub qtan {
my ( $self ) = @_;
$self->noUnits("tan");
return Quantity->new(tan($self->value), $self->units);
}
##
# Arcsinus
# @returns {Quantity}
##
sub qasin {
my ( $self ) = @_;
$self->noUnits("asin");
return Quantity->new(asin($self->value), $self->units);
}
##
# Arccosinus
# @returns {Quantity}
##
sub qacos {
my ( $self ) = @_;
$self->noUnits("acos");
return Quantity->new(acos($self->value), $self->units);
}
##
# Arctangent
# @returns {Quantity}
##
sub qatan {
my ( $self ) = @_;
$self->noUnits("atan");
return Quantity->new(atan($self->value), $self->units);
}
##
# Arctangent of self/x in the range -pi to pi
# @param {Quantity} x
# @returns {Quantity}
##
sub qatan2 {
my ( $self, $q ) = @_;
if (!$q->isa(Quantity)) {
die CalcException->new("Cannot calculate atan2 if second argument is not a quantity.");
}
$self->noUnits("atan2");
my $v = atan2($self->value, $q->value);
return Quantity->new($v, $self->units);
}
##
# Hyperbolic sinus
# @returns {Quantity}
##
sub qsinh {
my ( $self ) = @_;
$self->noUnits("sinh");
return Quantity->new(sinh($self->value), $self->units);
}
##
# Hyperbolic cosinus
# @returns {Quantity}
##
sub qcosh {
my ( $self ) = @_;
$self->noUnits("cosh");
return Quantity->new(cosh($self->value), $self->units);
}
##
# Hyperbolic tangent
# @returns {Quantity}
##
sub qtanh {
my ( $self ) = @_;
$self->noUnits("tanh");
return Quantity->new(tanh($self->value), $self->units);
}
##
# Hyperbolic arcsinus
# @returns {Quantity}
##
sub qasinh {
my ( $self ) = @_;
$self->noUnits("asinh");
return Quantity->new(asinh($self->value), $self->units);
}
##
# Hyperbolic arccosinus
# @returns {Quantity}
##
sub qacosh {
my ( $self ) = @_;
$self->noUnits("acosh");
return Quantity->new(acosh($self->value), $self->units);
}
##
# Hyperbolic arctangent
# @returns {Quantity}
##
sub qatanh {
my ( $self ) = @_;
$self->noUnits("atanh");
return Quantity->new(atanh($self->value), $self->units);
}
##
# Equals
# @param {Quantity|QVector|QMatrix|QSet|QInterval} q
# @optional {string|float} tolerance
# @returns {Quantity}
##
sub qeq {
my ( $self, $q, $tolerance ) = @_;
my $v = $self->equals($q, $tolerance);
return Quantity->new($v);
}
##
# Less than
# @param {Quantity}
# @returns {Quantity}
##
sub qlt {
my ( $self, $q ) = @_;
my $v = $self->lt($q);
return Quantity->new($v);
}
##
# Less than or equal
# @param {Quantity} q
# @returns {Quantity}
##
sub qle {
my ( $self, $q ) = @_;
my $v = $self->le($q);
return Quantity->new($v);
}
##
# Greater than
# @param {Quantity} q
# @returns {Quantity}
##
sub qgt {
my ( $self, $q ) = @_;
my $v = $self->gt($q);
return Quantity->new($v);
}
##
# Greater than or equal
# @param {Quantity} q
# @returns {Quantity}
##
sub qge {
my ( $self, $q ) = @_;
my $v = $self->ge($q);
return Quantity->new($v);
}
##
# Dies if units do not match.
##
sub unitsMatch {
my ( $self, $q, $fct_name ) = @_;
my %units = %{$self->units};
foreach my $unit (keys %units) {
if ($units{$unit} != $q->units->{$unit}) {
die CalcException->new("Units [_1] do not match.", $fct_name);
}
}
}
##
# Dies if there are any unit.
##
sub noUnits {
my ( $self, $fct_name ) = @_;
my %units = %{$self->units};
foreach my $unit (keys %units) {
if ($units{$unit} != 0) {
die CalcException->new("Cannot calculate [_1] of something with units.", $fct_name);
}
}
}
1;
__END__
Index: loncom/homework/math_parser/Token.pm
+++ loncom/homework/math_parser/Token.pm
# The LearningOnline Network with CAPA - LON-CAPA
# A parser token.
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# A token from the equation text
##
package Apache::math_parser::Token;
use strict;
use warnings;
use utf8;
use enum qw(UNKNOWN NAME NUMBER OPERATOR);
##
# Constructor
# @param {integer} type - Token type: Token::UNKNOWN, NAME, NUMBER, OPERATOR
# @param {integer} from - Index of the token's first character
# @param {integer} to - Index of the token's last character
# @param {string} value - String content of the token
# @optional {Operator} op - The matching operator
##
sub new {
my $class = shift;
my $self = {
_type => shift,
_from => shift,
_to => shift,
_value => shift,
_op => shift,
};
bless $self, $class;
return $self;
}
# Attribute helpers
sub type {
my $self = shift;
return $self->{_type};
}
sub from {
my $self = shift;
return $self->{_from};
}
sub to {
my $self = shift;
return $self->{_to};
}
sub value {
my $self = shift;
return $self->{_value};
}
sub op {
my $self = shift;
return $self->{_op};
}
1;
__END__
Index: loncom/homework/math_parser/Tokenizer.pm
+++ loncom/homework/math_parser/Tokenizer.pm
# The LearningOnline Network with CAPA - LON-CAPA
# String tokenizer
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# String tokenizer. Recognizes only names, numbers, and parser operators.
##
package Apache::math_parser::Tokenizer;
use strict;
use warnings;
use utf8;
use aliased 'Apache::math_parser::Definitions';
use aliased 'Apache::math_parser::ParseException';
use aliased 'Apache::math_parser::Token';
##
# @constructor
# @param {Definitions} defs - Operator definitions
# @param {string} text - The text to tokenize
##
sub new {
my $class = shift;
my $self = {
_defs => shift,
_text => shift,
};
bless $self, $class;
return $self;
}
# Attribute helpers
##
# Operator definitions
# @returns {Definitions}
##
sub defs {
my $self = shift;
return $self->{_defs};
}
##
# The text to tokenize
# @returns {string}
##
sub text {
my $self = shift;
return $self->{_text};
}
##
# Tokenizes the text.
# Can throw a ParseException.
# @returns {Token[]}
##
sub tokenize {
my( $self ) = @_;
my( $text, $c, $i, $from, @tokens, $value );
my @operators = @{$self->defs->operators};
my $dec1 = Definitions->DECIMAL_SIGN_1;
my $dec2 = Definitions->DECIMAL_SIGN_2;
$text = $self->text;
if (!defined $text) {
die "Math Tokenizer: undefined text";
}
if (!utf8::is_utf8($text)) {
utf8::decode($text);
}
$i = 0;
$c = $i < length($text) ? substr($text, $i, 1) : '';
@tokens = ();
main:
while ($c ne '') {
$from = $i;
# ignore whitespace
if ($c le ' ') {
$i++;
$c = $i < length($text) ? substr($text, $i, 1) : '';
next;
}
# check for numbers before operators
# (numbers starting with . will not be confused with the . operator)
if (($c ge '0' && $c le '9') ||
(($c eq $dec1 || $c eq $dec2) &&
(substr($text, $i+1, 1) ge '0' && substr($text, $i+1, 1) le '9'))) {
$value = '';
if ($c ne $dec1 && $c ne $dec2) {
$i++;
$value .= $c;
# Look for more digits.
for (;;) {
$c = $i < length($text) ? substr($text, $i, 1) : '';
if ($c lt '0' || $c gt '9') {
last;
}
$i++;
$value .= $c;
}
}
# Look for a decimal fraction part.
if ($c eq $dec1 || $c eq $dec2) {
$i++;
$value .= $c;
for (;;) {
$c = $i < length($text) ? substr($text, $i, 1) : '';
if ($c lt '0' || $c gt '9') {
last;
}
$i++;
$value .= $c;
}
}
# Look for an exponent part.
if ($c eq 'e' || $c eq 'E') {
$i++;
$value .= $c;
$c = $i < length($text) ? substr($text, $i, 1) : '';
if ($c eq '-' || $c eq '+') {
$i++;
$value .= $c;
$c = $i < length($text) ? substr($text, $i, 1) : '';
}
if ($c lt '0' || $c gt '9') {
# syntax error in number exponent
die ParseException->new("Syntax error in number exponent.", $from, $i);
}
do {
$i++;
$value .= $c;
$c = $i < length($text) ? substr($text, $i, 1) : '';
} while ($c ge '0' && $c le '9');
}
# Convert the string value to a number. If it is finite, then it is a good token.
my $n = eval "\$value =~ tr/".$dec1.$dec2."/../";
if (!($n == 9**9**9 || $n == -9**9**9 || ! defined( $n <=> 9**9**9 ))) {
push(@tokens, Token->new(Token->NUMBER, $from, $i - 1, $value));
next;
} else {
# syntax error in number
die ParseException->new("Syntax error in number.", $from, $i);
}
}
# check for operators before names (they could be confused with
# variables if they don't use special characters)
for (my $iop = 0; $iop < scalar(@operators); $iop++) {
my $op = $operators[$iop];
my $opid = $op->id;
if (substr($text, $i, length($opid)) eq $opid) {
$i += length($op->id);
$c = $i < length($text) ? substr($text, $i, 1) : '';
push(@tokens, Token->new(Token->OPERATOR, $from, $i - 1, $op->id, $op));
next main;
}
}
# names
if (($c ge 'a' && $c le 'z') || ($c ge 'A' && $c le 'Z') ||
($c ge 'α' && $c le 'ω') || ($c ge 'Α' && $c le 'Ω') || $c eq 'µ') {
$value = $c;
$i++;
for (;;) {
$c = $i < length($text) ? substr($text, $i, 1) : '';
if (($c ge 'a' && $c le 'z') || ($c ge 'A' && $c le 'Z') ||
($c ge 'α' && $c le 'ω') || ($c ge 'Α' && $c le 'Ω') || $c eq 'µ' ||
($c ge '0' && $c le '9') || $c eq '_') {
$value .= $c;
$i++;
} else {
last;
}
}
# "i" is turned into a NUMBER token
if ($value eq "i") {
push(@tokens, Token->new(Token->NUMBER, $from, $i - 1, $value));
next;
}
push(@tokens, Token->new(Token->NAME, $from, $i - 1, $value));
next;
}
# unrecognized operator
die ParseException->new("Unrecognized operator.", $from, $i);
}
return @tokens;
}
1;
__END__
Index: loncom/homework/math_parser/Units.pm
+++ loncom/homework/math_parser/Units.pm
# The LearningOnline Network with CAPA - LON-CAPA
# Units
#
# Copyright (C) 2014 Michigan State University Board of Trustees
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
##
# Loads and converts units
##
package Apache::math_parser::Units;
use strict;
use warnings;
use utf8;
use JSON::DWIW;
use File::Slurp;
use aliased 'Apache::math_parser::CalcException';
use aliased 'Apache::math_parser::Parser';
use aliased 'Apache::math_parser::Quantity';
use vars qw(%perlvar);
##
# Constructor
##
sub new {
my $class = shift;
my $self = {
_base => [], # array with the names
_prefix => {}, # hash symbol -> factor
_derived => {}, # hash symbol -> convert
_parser => Parser->new(1, 1),
};
bless $self, $class;
$self->loadUnits();
return $self;
}
# Attribute helpers
sub base {
my $self = shift;
return $self->{_base};
}
sub prefix {
my $self = shift;
return $self->{_prefix};
}
sub derived {
my $self = shift;
return $self->{_derived};
}
sub parser {
my $self = shift;
return $self->{_parser};
}
##
# Loads units from units.json
##
sub loadUnits {
my ( $self ) = @_;
my $units_txt = read_file("$Apache::lonnet::perlvar{'lonTabDir'}/units.json");
my $jsunits = JSON::DWIW->new->from_json($units_txt);
for (my $i=0; $i < scalar(@{$jsunits->{"base"}}); $i++) {
my $base = $jsunits->{"base"}->[$i];
push(@{$self->{_base}}, $base->{"symbol"});
}
for (my $i=0; $i < scalar(@{$jsunits->{"prefix"}}); $i++) {
my $prefix = $jsunits->{"prefix"}->[$i];
$self->{_prefix}->{$prefix->{"symbol"}} = $prefix->{"factor"};
}
for (my $i=0; $i < scalar(@{$jsunits->{"derived"}}); $i++) {
my $derived = $jsunits->{"derived"}->[$i];
$self->{_derived}->{$derived->{"symbol"}} = $derived->{"convert"};
}
}
##
# Converts a unit name into a Quantity. Throws an exception if the unit is not known.
# @param {CalcEnv} env - Calculation environment
# @param {string} name - the unit name
# @returns {Quantity}
##
sub convertToSI {
my ( $self, $env, $name ) = @_;
# possible speed optimization: we could cache the result
# check derived units first
my $convert = $self->derived->{$name};
if (defined $convert) {
my $root = $self->parser->parse($convert);
return $root->calc($env);
}
# then check base units, without or with a prefix
for (my $i=0; $i < scalar(@{$self->base}); $i++) {
my $base = $self->base->[$i];
if ($name eq $base) {
return $self->baseQuantity($base);
} else {
my $base2;
if ($base eq "kg") {
$base2 = "g";
} else {
$base2 = $base;
}
if ($name =~ /$base2$/) {
# look for a prefix
my $prefix = $self->prefix->{substr($name, 0, length($name) - length($base2))};
if (defined $prefix) {
my $v = $prefix;
$v =~ s/10\^/1E/;
if ($base2 eq "g") {
$v /= 1000;
}
return $self->baseQuantity($base) * Quantity->new($v);
}
}
}
}
# now check derived units with a prefix
foreach my $derived_name (keys(%{$self->derived})) {
if ($name =~ /$derived_name$/) {
my $prefix_v = $self->prefix->{substr($name, 0, length($name) - length($derived_name))};
if (defined $prefix_v) {
$prefix_v =~ s/10\^/1E/;
my $convert = $self->derived->{$derived_name};
my $root = $self->parser->parse($convert);
my $derived_v = $root->calc($env);
return $derived_v * Quantity->new($prefix_v);
}
}
}
die CalcException->new("Unit not found: [_1]", $name);
}
##
# Returns the Quantity for a base unit name
# @param {string} name - the unit name
# @returns {Quantity}
##
sub baseQuantity {
my ( $self, $name ) = @_;
my %h = (s => 0, m => 0, kg => 0, K => 0, A => 0, mol => 0, cd => 0);
$h{$name} = 1;
return Quantity->new(1, \%h);
}
1;
__END__
More information about the LON-CAPA-cvs
mailing list