Import provides support for Scheme's (import)
+ procedure. It is roughly like Java's import statement, with
+ important differences described below.
+
+
(import) can be used to import a single class, such as:
+
+ (import "java.util.Date")
+
+
+ Or all the classes of a package using the wildcard "*":
+
+
+ (import "java.util.*")
+
+
+
However, using wildcard imports is not recommend
+ (deprecated) for the following reasons:
+
+
+
+
Class name lookup using wildcards requires generating class names
+ that do not exits. While this is fast for an application, it can
+ take about a second for each lookup in an applet.
+
+
Conflicts between imports are identified at (import) time,
+ rather than later in runtime.
+
+
+**/
+import java.util.Hashtable;
+import java.util.Vector;
+import java.util.Enumeration;
+
+public class Import {
+
+ private static ClassLoader CLASSLOADER = Import.class.getClassLoader();
+ static {
+ try {
+ Thread.currentThread().setContextClassLoader
+ (Import.class.getClassLoader());}
+ catch (Exception e) {;}
+ }
+
+ /** Get the ClassLoader used to look up classes. **/
+ public static synchronized ClassLoader getClassLoader() {
+ return CLASSLOADER;
+ }
+ /** Set the ClassLoader used to look up classes. **/
+ public static synchronized void setClassLoader(ClassLoader cl) {
+ CLASSLOADER = cl;
+ Thread.currentThread().setContextClassLoader(cl);
+ }
+
+ /**
+ Fields singles and wilds should be HashSets which won't exist
+ until JDK 1.2. So we simulate them with Vectors, which existed
+ since JDK 1.0.
+ **/
+ public static final Vector singles = new Vector(50);
+ public static final Vector wilds = new Vector(50);
+ public static final Hashtable table = new Hashtable (200);
+
+ // KRA 17AUG01: Eventually add these as singles and wilds.
+ static {
+ addImport("java.lang.Object");
+ addImport("java.lang.*");
+ addImport("java.lang.reflect.*");
+ addImport("java.util.*");
+ addImport("jsint.*");
+ }
+
+ /** Add an import, clearing the cache if it's wild. **/
+ public static synchronized void addImport(String name) {
+ // System.out.println("addImport: " + name);
+ if (name.endsWith("*")) {
+ addNew(wilds, new WildImporter(name));
+ table.clear();
+ } else addNew(singles, new SingleImporter(name));
+ }
+
+ /* Use Vector to simulate a HashSet. */
+ private static void addNew(Vector v, Object x) {
+ if (x != null &&!v.contains(x)) v.addElement(x);
+ }
+
+ /**
+ Find a Class named name either relative to imports, or
+ absolute, or error. Names of the form $name are
+ interpreted as absolute specifications for package-less classes
+ for historical reasons.
+ **/
+ public static Class classNamed(String name) throws Exception {
+ Class c = maybeClassNamed(name);
+ return (c == null) ?
+ (Class) E.error("Can't find class " + name + "."):
+ c;
+ }
+
+ /** Returns a class or return null. **/
+ public static synchronized Class maybeClassNamed(String name) throws Exception {
+ Class c = ((Class) table.get(name)); // Cached?
+ if (c != null) return c;
+ c = classNamedLookup(name);
+ if (c != null) table.put(name, c);
+ return c;
+ }
+
+ private static Class classNamedLookup(String name) throws Exception {
+ if (name.endsWith("[]"))
+ return classNamedArray(name.substring(0, name.length() - "[]".length()));
+ Class c = classNamedImported(name);
+ if (c != null) return c;
+ return primitiveClassNamed(name);
+ }
+
+ /**
+ Search for class named name looking in singles.
+ Search packageless classes and wilds only if necessary.
+ **/
+ private static Class classNamedImported(String name) {
+ Vector classes = find(singles, name, new Vector(5));
+ if (name.lastIndexOf(".") == -1) { // No package prefix.
+ if (classes.size() == 0) classes = classNamedNoPackage(name, classes);
+ if (classes.size() == 0) classes = find(wilds, name, classes);
+ } else addNew(classes, Import.forName(name));
+ return returnClass(name, classes);
+ }
+
+ private static Class returnClass(String name, Vector classes) {
+ int L = classes.size();
+ if (L == 0) return null;
+ if (L == 1) return ((Class) classes.elementAt(0));
+ else
+ return ((Class) E.warn("Class " + name + " is ambiguous " + classes +
+ " choosing " + ((Class) classes.elementAt(0))));
+ }
+
+ private static Vector classNamedNoPackage(String name, Vector classes) {
+ addNew(classes, Import.forName((name.startsWith("$"))
+ ? name.substring(1,name.length())
+ : name));
+ return classes;
+ }
+
+ public static Vector find(Vector imports, String name, Vector classes) {
+ Enumeration is = imports.elements();
+ while (is.hasMoreElements())
+ addNew(classes, ((Importer) is.nextElement()).classNamed(name));
+ return classes;
+ }
+
+ /** name is the name of the component class. **/
+ private static Class classNamedArray(String name) throws Exception {
+ Class c = classNamed(name);
+ if (c.isPrimitive()) return classNamedArrayPrimitive(c);
+ if (c.isArray()) return Import.forName("[" + c.getName());
+ else return Import.forName("[L" + c.getName() + ";");
+ }
+
+ /** Ask the ClassLoader for a class given its full name. **/
+ public static Class forName(String name) {
+ ClassLoader loader = getClassLoader();
+ if (loader == null)
+ try { return Class.forName(name);}
+ catch (ClassNotFoundException e) { return null;}
+ else
+ try { return loader.loadClass(name); }
+ catch (ClassNotFoundException e) { return null; }
+ // KRA 28JUN00: Renu found this!
+ catch (NoClassDefFoundError e) { return null; }
+ }
+
+ /** Class.forName() doesn't work for primitive types. **/
+ private static Class primitiveClassNamed(String name) {
+ return
+ name.equals("void") ? Void.TYPE :
+ name.equals("boolean") ? Boolean.TYPE :
+ name.equals("byte") ? Byte.TYPE :
+ name.equals("char") ? Character.TYPE :
+ name.equals("short") ? Short.TYPE :
+ name.equals("int") ? Integer.TYPE :
+ name.equals("long") ? Long.TYPE :
+ name.equals("float") ? Float.TYPE :
+ name.equals("double") ? Double.TYPE :
+ null;
+ }
+
+ private static Class classNamedArrayPrimitive(Class c) {
+ return
+ // (c == void.class) ? void[].class :
+ (c == boolean.class) ? boolean[].class :
+ (c == byte.class) ? byte[].class :
+ (c == char.class) ? char[].class :
+ (c == short.class) ? short[].class :
+ (c == int.class) ? int[].class :
+ (c == long.class) ? long[].class :
+ (c == float.class) ? float[].class :
+ (c == double.class) ? double[].class :
+ null;
+ }
+
+ private Import() {} // Don't make one yourself.
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/Invoke.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/Invoke.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/Invoke.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/Invoke.java 2010-04-08 05:55:58.000000000 +0000
@@ -0,0 +1,553 @@
+package org.mathpiper.builtin.javareflection;
+
+/**
+ * @author Ken R. Anderson, Copyright 2000, kanderso@bbn.com, license
+ * subsequently modified by Jscheme project members
+ * licensed under zlib licence (see license.txt)
+ */
+
+//import java.lang.reflect.AccessibleObject; // only in JDK1.2 revision:
+import java.lang.reflect.Constructor;
+import java.lang.reflect.InvocationTargetException;
+import java.lang.reflect.Method;
+import java.lang.reflect.Member;
+import java.lang.reflect.Modifier;
+import java.util.Enumeration;
+import java.util.Hashtable;
+import java.util.Vector;
+import org.mathpiper.builtin.JavaObject;
+import org.mathpiper.lisp.cons.ConsPointer;
+
+/**
+ Provides dynamic Java method invocation through Java's Reflection
+ interface. For a good discussion of a Scheme implementation, and
+ the issues involved with dynamic method invocation in Java see:
+
+
Michael Travers, Java Q & A, Dr. Dobb's Journal, Jan., 2000,
+ p. 103-112.
+
+
Primitive types are not widened because it would make method
+ selection more ambiguous. By memoizing constructorTable() and
+ methodTable() dynamic method lookup can be done without consing.
+
+
You'll notice that Java doesn't make this very easy. For
+ example it would be nice if Method and Constructor shared an
+ Invokable interface.
+
+
Privileged methods can be invoked if the JVM allows it.
+
+
The name of a method to be invoked can be any nonnull Object
+ with a .toString() that names a method. It should probably be
+ changed to String.
+ **/
+
+public class Invoke {
+
+ /** Each bucket in an method table contains a Class[] of
+ parameterTypes and the corresponding method or constructor. **/
+ public static final int BUCKET_SIZE = 2;
+
+ public static Object peek(Object target, String name) throws Exception {
+ return peek0(target.getClass(), name, target);
+ }
+
+ public static Object peekStatic(Class c, String name) throws Exception {
+ return peek0(c, name, c);
+ }
+
+ private static Object peek0(Class c, String name, Object target) throws Exception {
+ try {
+ return c.getField(name).get(target);
+ } catch (NoSuchFieldException e) {
+ return E.error(target + " has no field named " + name);
+ } catch (IllegalAccessException e) {
+ return E.error("Can't access the " + name + " field of " + target);
+ }
+ }
+
+ public static Object poke(Object target, String name, Object value) throws Exception {
+ return poke0(target.getClass(), name, target, value);
+ }
+
+ public static Object pokeStatic(Class c, String name, Object value) throws Exception {
+ return poke0(c, name, c, value);
+ }
+
+ private static Object poke0(Class c, String name, Object target,
+ Object value) throws Exception {
+ try {
+ c.getField(name).set(target, value);
+ return value;
+ } catch (NoSuchFieldException e) {
+ return E.error(target + " has no field named " + name);
+ } catch (IllegalAccessException e) {
+ return E.error("Can't access the " + name + " field of " + target);
+ }
+ }
+
+ public static Object invokeConstructor(String c, Object[] args) throws Exception{
+ Object[] ms = constructorTable(c, false);
+ return invokeRawConstructor (((Constructor) findMethod(ms, args)), args);
+ }
+
+ public static Object invokeRawConstructor(Constructor m, Object[] args) throws Exception{
+ try {
+ return m.newInstance(args);
+ } catch (InvocationTargetException e) {
+ //throw new BacktraceException(e.getTargetException(),new Object[]{m,args});
+ throw e; //todo:tk.
+ } catch (InstantiationException e) {
+ return E.error("Error during instantiation: ", U.list(e, m, args));
+ } catch (IllegalAccessException e) {
+ return E.error("Bad constructor application:", U.list(e, m, args));
+ }
+ }
+
+ public static Object invokeStatic(Class c, String name, Object[] args) throws Exception{
+ return invokeMethod(c, c, name, args, true, false);
+ }
+
+ public static Object invokeInstance(Object target, String name,
+ Object[] args,boolean isPrivileged) throws Exception{
+ return invokeMethod(target.getClass(), target, name, args, false,
+ isPrivileged);
+ }
+
+ public static Object invokeMethod(Class c, Object target, String name,
+ Object[] args, boolean isStatic,
+ boolean isPrivileged) throws Exception{
+ Object[] ms = methodTable(c, name, isStatic,isPrivileged);
+ return invokeRawMethod((Method) findMethod(ms, args), target, args);
+ }
+
+ public static Object invokeRawMethod(Method m, Object target, Object[] args) throws Exception{
+ try {
+ return m.invoke(target, args);
+ } catch (InvocationTargetException e) {
+ //throw new BacktraceException(e.getTargetException(),new Object[]{m,target,args});
+ throw e; //todo:tk.
+ } catch (IllegalAccessException e) {
+ return E.error("Bad method application from a private class: ", U.list(e, m, args));
+ } catch (java.lang.IllegalArgumentException e) {
+ if (args == null) return E.error(e + "\n " + m.toString() + "\n called with target: " + U.stringify(target) + " and a null argument vector.");
+ else return E.error(e + "\nARGUMENT MISMATCH for method \n\n "+m.toString() +"\n called with " + U.vectorToList(args));
+ }
+ }
+ public static final Hashtable constructorCache = new Hashtable(50);
+ public static final Hashtable constructorCachePriv = new Hashtable(50);
+
+ /** Return the constructor table for the named class. **/
+ public static Object[] constructorTable(String c, boolean isPrivileged) throws Exception {
+ if (isPrivileged) return constructorTable0Priv(c);
+ else return constructorTable0(c);
+ }
+
+ public static Object[] constructorTable0Priv(String c) throws Exception {
+ Object[] result = ((Object[]) constructorCachePriv.get(c));
+ if (result == null) {
+ try{
+ result = methodArray(makeAccessible(Import.classNamed(c).
+ getDeclaredConstructors()));
+ }catch(Exception e){
+ result = methodArray(Import.classNamed(c).getConstructors());}
+ constructorCachePriv.put(c, result);
+ }
+ if (result.length == 0)
+ return((Object[]) E.error("Constructor " + c +
+ " has no methods."));
+ else return result;
+ }
+
+ public static Object[] constructorTable0(String c) throws Exception {
+ Object[] result = ((Object[]) constructorCache.get(c));
+ if (result == null) {
+ result = methodArray(Import.classNamed(c).getConstructors());
+ constructorCache.put(c, result);
+ }
+ if (result.length == 0)
+ return((Object[]) E.error("Constructor " + c +
+ " has no methods."));
+ else return result;
+ }
+ /** Static method name -> Class -> parameter[]/method array. **/
+ public static final Hashtable staticCache = new Hashtable(50);
+ /** Instance method name -> Class -> parameter[]/method array. **/
+ public static final Hashtable instanceCache = new Hashtable(100);
+ private static Hashtable getMethodCache(boolean isStatic) {
+ return (isStatic) ? staticCache : instanceCache;
+ }
+
+ private static Hashtable getNameTable(Hashtable table, String name) {
+ Hashtable nameTable = ((Hashtable) table.get(name));
+ if (nameTable != null) return ((Hashtable) nameTable);
+ else {
+ nameTable = new Hashtable(10);
+ table.put(name, nameTable);
+ return ((Hashtable) nameTable);
+ }
+ }
+
+ /** Returns a Class -> prameter[]/method array for the method named
+ * name. **/
+ public static Hashtable getClassTable (String name, boolean isStatic) {
+ return getNameTable(getMethodCache(isStatic), name);
+ }
+
+ public static Object[] getCachedMethodTable
+ (Class c, String name, boolean isStatic) {
+ return ((Object[]) getNameTable(getMethodCache(isStatic), name) .get(c));
+ }
+
+ public static void putCachedMethodTable
+ (Class c, String name, boolean isStatic, Object value) {
+ getNameTable(getMethodCache(isStatic), name).put(c, value);
+ }
+
+ public static Object[] methodTable0
+ (Class c, String name, boolean isStatic,boolean isPrivileged) {
+ String internalName = isPrivileged?name.concat("#"):name;
+ Object[] result1 = getCachedMethodTable(c, internalName, isStatic);
+ if (result1 == null) {
+ result1 = methodTableLookup(c, name, isStatic,isPrivileged);
+ putCachedMethodTable(c, internalName, isStatic, result1);
+ }
+ return result1;
+ }
+
+ public static Object[] methodTable
+ (Class c, String name, boolean isStatic,boolean isPrivileged) throws Exception {
+ Object[] result1 = methodTable0(c, name, isStatic,isPrivileged);
+ if (result1 == null || result1.length == 0)
+ if (isStatic)
+ return ((Object[]) E.error ("ERROR: \nNO STATIC METHOD OF TYPE \n\n ("+ c.getName()+"."+ name+ " ...)"));
+ else
+ return ((Object[]) E.error("ERROR: \nNO INSTANCE METHOD OF TYPE \n\n (."+ name+ " "+ c.getName() +" ...)"));
+ else return result1;
+ }
+
+ public static Object[] methodTableLookup(Class c, String name,boolean isStatic,boolean isPrivileged) {
+ if (isStatic) return methodTableLookupStatic(c, name,isPrivileged);
+ else return methodTableLookupInstance(c, name, isPrivileged);
+ }
+
+ public static Object[] methodTableLookupStatic(Class c, String name, boolean isPrivileged) {
+ Method[] ms = getMethods(c,isPrivileged);
+ Vector result = new Vector(ms.length);
+ for(int i = 0; i < ms.length; i++) {
+ Method m = ms[i];
+ if (Modifier.isStatic(m.getModifiers()) && m.getName().equals(name))
+ result.addElement(m);
+ }
+ Object[] result1 = new Object[result.size()];
+ result.copyInto(result1);
+ return methodArray(result1);
+ }
+
+ public static Object[] methodTableLookupInstance(Class c, String name) {
+ return methodTableLookupInstance(c, name,false);
+ }
+
+ public static Object[] methodTableLookupInstance(Class c, String name,
+ boolean isPrivileged) {
+ Vector result = methodVector(c, name, isPrivileged);
+ Object[] result1 = new Object[result.size()];
+ result.copyInto(result1);
+ return methodArray(result1);
+ }
+
+ public static Vector methodVector(Class c, String name) {
+ return methodVector(c,name,false);
+ }
+
+ public static Vector methodVector(Class c, String name, boolean isPrivileged) {
+ return methodVectorMerge(c, name, new Vector(10),isPrivileged);
+ }
+
+ /** Add new methods to your superclasses table. **/
+ public static Vector methodVectorMerge(Class c, String name, Vector result) {
+ return methodVectorMerge(c, name, result, false);
+ }
+
+ public static Vector methodVectorMerge(Class c, String name, Vector result,boolean isPrivileged) {
+ Class s = c.getSuperclass();
+
+ if (s != null) result = methodVectorMerge(s, name, result,isPrivileged);
+ Class[] is = c.getInterfaces();
+ for (int i = 0; i < is.length; i = i + 1)
+ result = methodVectorMerge(is[i], name, result,isPrivileged);
+
+ Method[] ms = getMethods(c,isPrivileged);
+ for(int i = 0; i < ms.length; i++) {
+ Method m = ms[i];
+ if ((!Modifier.isStatic(m.getModifiers())) &&
+ // KRA 25OCT04: Fixes problem with .append in JDK 1.5.0
+ ((isPrivileged ||
+ (Modifier.isPublic(m.getModifiers()) &&
+ Modifier.isPublic(m.getDeclaringClass().getModifiers())))
+ &&
+ m.getName().equals(name)))
+ maybeAdd(result, m);
+
+ }
+ return result;
+ }
+
+ /** Only add an instance method if no superclass provides one. **/
+ private static void maybeAdd(Vector result, Method m1) {
+ for(int i = 0; i < result.size(); i++) {
+ Method m2 = ((Method) result.elementAt(i));
+ if(parameterTypesMatch(getParameterTypes(m1), getParameterTypes(m2)))
+ return;
+ }
+ result.addElement(m1);
+ }
+
+ private static Class[] getParameterTypes(Object m) {
+ return (m instanceof Method) ? ((Method) m).getParameterTypes() :
+ ((Constructor) m).getParameterTypes();
+ }
+
+ /** Returns Object[] of parameterType, method pairs. **/
+ private static Object[] methodArray(Object[] v) {
+ Object[] result = new Object[v.length*BUCKET_SIZE];
+ for(int i = 0; i < v.length; i++) {
+ result[i*BUCKET_SIZE] = getParameterTypes(v[i]);
+ result[i*BUCKET_SIZE+1] = v[i];
+ }
+ return result;
+ }
+
+ /** Do the paramter types of an instance method match? **/
+ public static boolean parameterTypesMatch(Class[] p1, Class[] p2) {
+ if (p1.length == p2.length) {
+ for (int i = 0; i < p1.length; i++)
+ if (p1[i] != p2[i]) return false;
+ return true;
+ } else return false;
+ }
+
+ /** Find the most applicable method. For instance methods
+ getMethods() has already handled the "this" argument, so
+ instance and static methods are matched the same way. **/
+
+ public static Object findMethod(Object[] methods, Object[] args) throws Exception {
+ if (methods.length == BUCKET_SIZE)
+ return methods[1]; // Hope it works!
+ return findMethodNoOpt(methods,args);
+ }
+
+ static Object findMethodNoOpt(Object[] methods, Object[] args) throws Exception {
+ int best = -1;
+ for(int m1 = 0; m1 < methods.length; m1 = m1 + BUCKET_SIZE) {
+ Class[] p1 = ((Class[]) methods[m1]);
+ if (isApplicable(p1, args) &&
+ (best == -1 || !moreApplicable(((Class[]) methods[best]), p1)))
+ best = m1;
+ }
+ if (best != -1) return methods[best+1];
+
+ // print debugging info
+ StringBuffer alts = new StringBuffer();
+ for(int m1 = 0; m1 < methods.length; m1 = m1 + BUCKET_SIZE)
+ if (methods[m1+1] instanceof Member)
+ alts.append(" * "+methods[m1+1] +"\n");
+ else {
+ Class[] ts=(Class[]) methods[m1];
+ alts.append(" * "+methods[m1+1]+" ( ");
+ for (int i=0;iThis is only used by (method).
+ **/
+ public static Method findMethod(String name, Object target, ConsPointer types) throws Exception {
+ try {
+ return U.toClass(target).getMethod(name, toClassArray(types, 0));
+ } catch(NoSuchMethodException e) {
+ return ((Method) E.error("No method: ", U.list(name, target, types)));
+ }
+ }
+
+ /** Look up a particular constructor given its name, and the name of its
+ declaring class, and a list of argument type names.
+
This is only used by (constructor).
+ **/
+ public static Constructor findConstructor(Object target, ConsPointer types) throws Exception{
+ try {
+ return U.toClass(target).getConstructor(toClassArray(types, 0));
+ } catch(NoSuchMethodException e) {
+ return ((Constructor) E.error("No constructor: ", U.list(target, types)));
+ }
+ }
+
+ public static Constructor findConstructor(String target, Object[] arguments) throws Exception{
+ Class[] argumentsArray = new Class[arguments.length];
+
+ for(int index = 0; index < arguments.length; index++)
+ {
+ Object argument = arguments[index];
+ if(argument instanceof JavaObject)
+ {
+ argument = ((JavaObject)argument).getObject();
+ }
+
+ argumentsArray[index] = U.toClass(argument.getClass());
+ }//for.
+
+ Constructor constructor = U.toClass(target).getConstructor(argumentsArray);
+
+ return constructor;
+ }
+
+ public static Class[] toClassArray(ConsPointer types, int n) throws Exception{
+ if (types.getCons() == null /*types == Pair.EMPTY*/) return new Class[n];
+ else {
+ Class[] cs = toClassArray(((ConsPointer) types.getCons().cdr()), n + 1);
+ cs[n] = U.toClass(types.car());
+ return cs;
+ }
+ }
+
+ /** Return all the methods for this class. If you can't get all, for
+ * some reason,, just return the public ones.
+
Memoizable.
+ **/
+ public static Method[] getMethods(Class c,boolean isPrivileged) {
+ Method[] methods = getAllMethods(c,isPrivileged);
+ return (methods == null) ? c.getMethods() : methods;
+ }
+
+ /** Return all the methods on this class, and make them accessable.
+ If you can't for some reason, return null;
+ **/
+ private static Method[] getAllMethods(Class c) {
+ return getAllMethods(c,false);
+ }
+
+ private static Method[] getAllMethods(Class c,boolean isPrivileged) {
+ if (isPrivileged)
+ try{return ((Method[]) makeAccessible(getAllMethods0(c)));}
+ catch(Exception e){return null;}
+ else return null;
+ }
+
+ /**
+ In some situations you may not be able to get declared methods.
+ We only try once.
+ **/
+ static final boolean ALLOW_PRIVATE_ACCESS=true;
+ private static boolean CAN_GET_DECLARED_METHODS = ALLOW_PRIVATE_ACCESS
+ ? canGetDeclaredMethods() : false;
+ private static boolean canGetDeclaredMethods () {
+ try {
+ Invoke.class.getDeclaredMethods();
+ return true;
+ } catch (Exception e) {return false;}}
+
+ private static Method[] getAllMethods0 (Class c) {
+ if (CAN_GET_DECLARED_METHODS) {
+ Hashtable table = new Hashtable(35);
+ collectDeclaredMethods(c, table);
+ Enumeration e = ((Enumeration) table.elements());
+ Method[] ms = new Method[table.size()];
+ for (int i=0; e.hasMoreElements(); i++)
+ ms[i] = ((Method)e.nextElement());
+ return ms;
+ }
+ else return null;
+ }
+
+ private static void collectDeclaredMethods(Class c, Hashtable h) {
+ Method[] ms = c.getDeclaredMethods();
+ for (int i = 0; i < ms.length; i++) h.put(ms[i], ms[i]);
+ Class[] is = c.getInterfaces();
+ for (int j = 0; j < is.length; j++) collectDeclaredMethods(is[j], h);
+ Class sup = c.getSuperclass();
+ if (sup != null) collectDeclaredMethods(sup, h);
+ }
+
+ /**
+ Check that this JVM has AccessibleObject.
+ We only try once.
+ **/
+ static Method SETACCESSIBLE = getSetAccessibleMethod();
+ private static Method getSetAccessibleMethod() {
+ try {
+ Class c = Class.forName("java.lang.reflect.AccessibleObject");
+ Class ca = Class.forName("[Ljava.lang.reflect.AccessibleObject;");
+ return c.getMethod("setAccessible", new Class[] { ca, Boolean.TYPE });
+ } catch (Exception e) {return null;}}
+
+ /** Items should be of type AccessibleObject[] but we can't say that
+ on JVM's older than JDK 1.2
+
Also used by JavaField.
+ **/
+ static Object[] makeAccessible(Object[] items) {
+ if (items != null && SETACCESSIBLE != null) {
+ // AccessibleObject.setAccessible(items, true);
+ try {
+ SETACCESSIBLE.invoke(null, new Object[] { items, Boolean.TRUE });
+ } catch (Exception e) {}
+ }
+ return items;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaConstructor.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaConstructor.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaConstructor.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaConstructor.java 2010-04-08 05:55:58.000000000 +0000
@@ -0,0 +1,51 @@
+package org.mathpiper.builtin.javareflection;
+import java.lang.reflect.Constructor;
+
+/** Provides dynamic constructors.
+ * @author Peter Norvig, Copyright 1998, peter@norvig.com, license
+ * subsequently modified by Jscheme project members
+ * licensed under zlib licence (see license.txt)
+ **/
+
+public class JavaConstructor extends StaticReflector {
+
+ private transient Object[] methods;
+
+ /** Depricated! **/
+ public JavaConstructor(Class c) throws Exception {
+ this(c.getName());
+ }
+
+ public JavaConstructor(String c, boolean isPrivileged) throws Exception {
+ this.name = c;
+ this.isPrivileged = isPrivileged;
+ this.reset();
+ }
+
+ public JavaConstructor(String c) throws Exception {
+ this(c,false);
+ }
+
+ public Object apply(Object[] args) throws Exception{
+ return Invoke.invokeRawConstructor
+ (((Constructor) Invoke.findMethod(methods, args)), args);
+ }
+
+ protected synchronized void reset() throws Exception {
+ methods = Invoke.constructorTable(name, isPrivileged);
+
+ int min = Integer.MAX_VALUE;
+ int max = 0;
+
+ for(int i = 0; i < methods.length; i = i + Invoke.BUCKET_SIZE) {
+ int n = ((Object[]) methods[i]).length;
+ if (n < min) min = n;
+ if (n > max) max = n;
+ }
+ minArgs = min;
+ maxArgs = max;
+ }
+
+ /** Code is like (vector Hashtable. 10), ie the first element is the
+ Constructor. **/
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaField.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaField.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaField.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaField.java 2010-04-08 05:55:58.000000000 +0000
@@ -0,0 +1,192 @@
+package org.mathpiper.builtin.javareflection;
+import java.lang.reflect.*;
+import java.util.Hashtable;
+import org.mathpiper.lisp.cons.Cons;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Utility;
+
+/**
+ * Provides dynamic field access.
+
+ If the field is static (or a Class is given) we cache the Field.
+ Otherwise, we cache a class-> field map.
+ * @author Peter Norvig, Copyright 1998, peter@norvig.com, license
+ * subsequently modified by Jscheme project members
+ * licensed under zlib licence (see license.txt)
+**/
+
+public class JavaField extends Reflector {
+
+ /** Maps field name -> Class -> Field **/
+ static final Hashtable fieldTable = new Hashtable(20);
+ static final Hashtable fieldTablePriv = new Hashtable(20);
+
+ static Hashtable fieldTable0(boolean isPrivileged) {
+ if (isPrivileged) return fieldTablePriv;
+ else return fieldTable;
+ }
+
+ /**
+ Return the field named name in Class c.
+ Priviledged fields are made accessible if the JVM allows it.
+
Memoized.
+ **/
+ public static Field getField(Class c, String name, boolean isPrivileged) throws Exception {
+ try{
+ return isPrivileged
+ ? getDeclaredField(c, name)
+ : c.getField(name);
+ } catch(NoSuchFieldException e2) {
+ return((Field)E.error("no such field: " + c+"."+name));
+ } catch(Exception e) {
+ return((Field)E.error
+ ("error accessing field: " + c+"."+name+ " is "+e));
+ }
+ }
+
+ private static Hashtable getFieldClassTable
+ (String name, boolean isPrivileged) {
+ Hashtable ft = fieldTable0(isPrivileged);
+ Hashtable table = ((Hashtable) ft.get(name));
+ if (table == null) {
+ table = new Hashtable(3);
+ ft.put(name, table);
+ }
+ return table;
+ }
+
+ /** Wander over the declared fields, returning the first named
+ name **/
+ private static Field getDeclaredField (Class c, String name)
+ throws NoSuchFieldException {
+ try{
+ Field[] fs = ((Field[]) Invoke.makeAccessible(c.getDeclaredFields()));
+ for (int i = 0; i < fs.length; i++)
+ if (fs[i].getName().equals(name)) return fs[i];
+ Class s = c.getSuperclass();
+ if (s != null) return getDeclaredField(s, name);
+ else return ((Field) E.error
+ ("\n\nERROR: no field: \""+name+"\" for class \""+c+"\""));
+ }catch(Exception e) {
+ return c.getField(name);}
+ }
+
+ String className;
+ transient Field f;
+ boolean isStatic = false;
+ /** Map Class -> Field **/
+ transient Hashtable classTable;
+
+ public JavaField(String name, Class c) throws Exception {
+ this(name, c, false);
+ }
+
+ public JavaField(String name, Class c, boolean isPrivileged) throws Exception {
+ this.name = name;
+ this.isPrivileged=isPrivileged;
+ if (c != null) this.className = c.getName();
+ reset();
+ }
+
+ protected synchronized void reset() throws Exception {
+ Class c = (className == null) ? null : Import.classNamed(className);
+ if (c != null) {
+ f = getField(c, name, isPrivileged);
+ isStatic = Modifier.isStatic(f.getModifiers());
+ minArgs = (isStatic) ? 0 : 1;
+ maxArgs = (Modifier.isFinal(f.getModifiers())) ? minArgs : minArgs+1;
+ } else {
+ classTable = getFieldClassTable(name, isPrivileged);
+ minArgs = 1;
+ maxArgs = 2;
+ }}
+
+
+ /*
+ public Object[] makeArgArray(Object[] code,
+ Evaluator eval,
+ LexicalEnvironment lexenv) {
+ int L = code.length - 1;
+ if (L == 0 && isStatic) return StaticReflector.args0;
+ else if (L == 1)
+ return new Object[] { eval.execute(code[1], lexenv) };
+ else if (L == 2 && !isStatic)
+ return new Object[] { eval.execute(code[1], lexenv),
+ eval.execute(code[2], lexenv) };
+ else return ((Object[]) E.error("Wrong number of arguments to field " +
+ this + " " + U.stringify(code)));
+ }*/
+
+
+ /*
+ public Object[] makeArgArray (ConsPointer args) throws Exception{
+ int L = Utility.listLength(null, -1, args);// args.length();
+ if (L == 0 && isStatic) return StaticReflector.args0;
+ else if (L == 1) return new Object[] { args.cdr() };
+ else if (L == 2 && !isStatic)
+ return new Object[] { args.cdr(), args.second() };
+ else return ((Object[]) E.error("Wrong number of arguments to field " +
+ this + " " + U.stringify(args)));
+ }*/
+
+ public Object apply(Object[] args) throws Exception {
+ int L = args.length;
+ if (isStatic) {
+ if (L == 1) return setStaticFieldValue(f, args[0]);
+ else return getStaticFieldValue(f);
+ } else {
+ if (L == 1) return getFieldValue(args[0], getTargetField(args[0]));
+ else return setFieldValue(args[0],
+ getTargetField(args[0]),
+ args[1]);
+ }
+ }
+
+ public Field getTargetField(Object target) throws Exception {
+ if (f != null) return f;
+ Class c = target.getClass();
+ Field it = ((Field) classTable.get(c));
+ if (it != null) return it;
+ it = getField(c, this.name, this.isPrivileged);
+ if (it == null) return (Field) E.error(U.stringify(target) +
+ " does not have a field "
+ + this.name);
+ classTable.put(c, it);
+ return it;
+ }
+
+ public Object getFieldValue(Object target, Field f) throws Exception {
+ try { return f.get(target); }
+ catch (IllegalAccessException e) {
+ return ((Object) E.error("Illegal Access to field: " + f + " in " +
+ U.stringify(target)));
+ }}
+
+ public Object setFieldValue(Object target, Field f, Object value) {
+ try {
+ Object old = f.get(target);
+ f.set(target, value);
+ return old;
+ } catch (IllegalAccessException e) {
+ return null; // Sorry.
+ }
+ }
+
+ public Object getStaticFieldValue(Field f) {
+ try {
+ return f.get(null);
+ } catch(IllegalAccessException e) {
+ return null; // Sorry.
+ }
+ }
+
+ public Object setStaticFieldValue(Field f, Object value) {
+ try {
+ Object old = f.get(null);
+ f.set(null, value);
+ return old;
+ } catch(IllegalAccessException e) {
+ return null; // Sorry.
+ }
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaMethod.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaMethod.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/javareflection/JavaMethod.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/javareflection/JavaMethod.java 2010-04-08 05:55:58.000000000 +0000
@@ -0,0 +1,144 @@
+package org.mathpiper.builtin.javareflection;
+
+import java.lang.reflect.Method;
+import java.util.Hashtable;
+import org.mathpiper.lisp.cons.ConsPointer;
+
+/** This class allows you to call any Java method, just by naming it,
+ * and doing the dispatch at runtime.
+ * @author Peter Norvig, Copyright 1998, peter@norvig.com, license
+ * subsequently modified by Jscheme project members
+ * licensed under zlib licence (see license.txt)
+**/
+
+public class JavaMethod extends Reflector {
+
+ public static final Object[] ZERO_ARGS = new Object[0];
+
+ private String methodClass;
+ /** Parameter/method table for a specific method. **/
+ private transient Object[] methodTable;
+ private boolean isStatic;
+ /** Do we know the Class that this method applies to? **/
+ private boolean isSpecific;
+ /** Class -> methodTable map. **/
+ private transient Hashtable classMethodTable;
+
+ public boolean isStatic() { return this.isStatic;}
+
+ /**
+
+ If the method is static then Class c is not null. For instance
+ methods, if Class c is not null, then it is used at construction
+ time to create a method table. Otherwise, the class of the
+ method is determined at call time from the target, and the method
+ table is constructed then and cached. Examples (see DynamicVariable.java):
+
+
+ new JavaMethod("getProperties", System.class, true) - static method
+ new JavaMethod("put", Hashtable.class,false) - specific instance method.
+ new JavaMethod("put", null, false) - unspecified instance method
+
+ * Some code taken and adapted from the Java 2D Graph Package 2.4,
+ * which in turn is a port from the Cephes 2.2 Math Library (C).
+ * Most Cephes code (missing from the 2D Graph Package) directly ported.
+ *
+ * @author wolfgang.hoschek@cern.ch
+ * @version 0.9, 22-Jun-99
+ */
+public class Gamma extends Constants {
+/**
+ * Makes this class non instantiable, but still let's others inherit from it.
+ */
+protected Gamma() {}
+/**
+ * Returns the beta function of the arguments.
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * where C = 1 and hence is omitted from the array.
+ * N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N-1] = C .
+ * N-1 0
+ *
+ * Calling arguments are otherwise the same as polevl().
+ *
+ * In the interest of speed, there are no checks for out of bounds arithmetic.
+ *
+ * @param x argument to the polynomial.
+ * @param coef the coefficients of the polynomial.
+ * @param N the degree of the polynomial.
+ */
+public static double p1evl( double x, double coef[], int N ) throws ArithmeticException {
+ double ans;
+
+ ans = x + coef[0];
+
+ for(int i=1; iN at x.
+ *
+ * 2 N
+ * y = C + C x + C x +...+ C x
+ * 0 1 2 N
+ *
+ * Coefficients are stored in reverse order:
+ *
+ * coef[0] = C , ..., coef[N] = C .
+ * N 0
+ *
+ * This function is identical to the incomplete beta
+ * integral function Gamma.incompleteBeta(a, b, x).
+ *
+ * The complemented function is
+ *
+ * 1 - P(1-x) = Gamma.incompleteBeta( b, a, x );
+ *
+ */
+static public double beta(double a, double b, double x ) {
+ return Gamma.incompleteBeta( a, b, x );
+}
+/**
+ * Returns the area under the right hand tail (from x to
+ * infinity) of the beta density function.
+ *
+ * This function is identical to the incomplete beta
+ * integral function Gamma.incompleteBeta(b, a, x).
+ */
+static public double betaComplemented(double a, double b, double x ) {
+ return Gamma.incompleteBeta( b, a, x );
+}
+/**
+ * Returns the sum of the terms 0 through k of the Binomial
+ * probability density.
+ *
+ * k
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = binomial( k, n, p ) = Gamma.incompleteBeta( n-k, k+1, 1-p ).
+ *
+ * All arguments must be positive,
+ * @param k end term.
+ * @param n the number of trials.
+ * @param p the probability of success (must be in (0.0,1.0)).
+ */
+static public double binomial(int k, int n, double p) {
+ if( (p < 0.0) || (p > 1.0) ) throw new IllegalArgumentException();
+ if( (k < 0) || (n < k) ) throw new IllegalArgumentException();
+
+ if( k == n ) return( 1.0 );
+ if( k == 0 ) return Math.pow( 1.0-p, n-k );
+
+ return Gamma.incompleteBeta( n-k, k+1, 1.0 - p );
+}
+/**
+ * Returns the sum of the terms k+1 through n of the Binomial
+ * probability density.
+ *
+ * n
+ * -- ( n ) j n-j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=k+1
+ *
+ * The terms are not summed directly; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = binomialComplemented( k, n, p ) = Gamma.incompleteBeta( k+1, n-k, p ).
+ *
+ * All arguments must be positive,
+ * @param k end term.
+ * @param n the number of trials.
+ * @param p the probability of success (must be in (0.0,1.0)).
+ */
+static public double binomialComplemented(int k, int n, double p) {
+ if( (p < 0.0) || (p > 1.0) ) throw new IllegalArgumentException();
+ if( (k < 0) || (n < k) ) throw new IllegalArgumentException();
+
+ if( k == n ) return( 0.0 );
+ if( k == 0 ) return 1.0 - Math.pow( 1.0-p, n-k );
+
+ return Gamma.incompleteBeta( k+1, n-k, p );
+}
+/**
+ * Returns the area under the left hand tail (from 0 to x)
+ * of the Chi square probability density function with
+ * v degrees of freedom.
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chiSquare( v, x ) = incompleteGamma( v/2.0, x/2.0 ).
+ *
+ * The arguments must both be positive.
+ *
+ * @param v degrees of freedom.
+ * @param x integration end point.
+ */
+static public double chiSquare(double v, double x) throws ArithmeticException {
+ if( x < 0.0 || v < 1.0 ) return 0.0;
+ return Gamma.incompleteGamma( v/2.0, x/2.0 );
+}
+/**
+ * Returns the area under the right hand tail (from x to
+ * infinity) of the Chi square probability density function
+ * with v degrees of freedom.
+ *
+ * inf.
+ * -
+ * 1 | | v/2-1 -t/2
+ * P( x | v ) = ----------- | t e dt
+ * v/2 - | |
+ * 2 | (v/2) -
+ * x
+ *
+ * where x is the Chi-square variable.
+ *
+ * The incomplete gamma integral is used, according to the
+ * formula
+ *
+ * y = chiSquareComplemented( v, x ) = incompleteGammaComplement( v/2.0, x/2.0 ).
+ *
+ *
+ * The arguments must both be positive.
+ *
+ * @param v degrees of freedom.
+ */
+static public double chiSquareComplemented(double v, double x) throws ArithmeticException {
+ if( x < 0.0 || v < 1.0 ) return 0.0;
+ return Gamma.incompleteGammaComplement( v/2.0, x/2.0 );
+}
+/**
+ * Returns the error function of the normal distribution; formerly named erf.
+ * The integral is
+ *
+ * Code adapted from the Java 2D Graph Package 2.4,
+ * which in turn is a port from the Cephes 2.2 Math Library (C).
+ *
+ * @param a the argument to the function.
+ */
+static public double errorFunction(double x) throws ArithmeticException {
+ double y, z;
+ final double T[] = {
+ 9.60497373987051638749E0,
+ 9.00260197203842689217E1,
+ 2.23200534594684319226E3,
+ 7.00332514112805075473E3,
+ 5.55923013010394962768E4
+ };
+ final double U[] = {
+ //1.00000000000000000000E0,
+ 3.35617141647503099647E1,
+ 5.21357949780152679795E2,
+ 4.59432382970980127987E3,
+ 2.26290000613890934246E4,
+ 4.92673942608635921086E4
+ };
+
+ if( Math.abs(x) > 1.0 ) return( 1.0 - errorFunctionComplemented(x) );
+ z = x * x;
+ y = x * Polynomial.polevl( z, T, 4 ) / Polynomial.p1evl( z, U, 5 );
+ return y;
+}
+/**
+ * Returns the complementary Error function of the normal distribution; formerly named erfc.
+ *
+ * Implementation:
+ * For small x, erfc(x) = 1 - erf(x); otherwise rational
+ * approximations are computed.
+ *
+ * Code adapted from the Java 2D Graph Package 2.4,
+ * which in turn is a port from the Cephes 2.2 Math Library (C).
+ *
+ * @param a the argument to the function.
+ */
+static public double errorFunctionComplemented(double a) throws ArithmeticException {
+ double x,y,z,p,q;
+
+ double P[] = {
+ 2.46196981473530512524E-10,
+ 5.64189564831068821977E-1,
+ 7.46321056442269912687E0,
+ 4.86371970985681366614E1,
+ 1.96520832956077098242E2,
+ 5.26445194995477358631E2,
+ 9.34528527171957607540E2,
+ 1.02755188689515710272E3,
+ 5.57535335369399327526E2
+ };
+ double Q[] = {
+ //1.0
+ 1.32281951154744992508E1,
+ 8.67072140885989742329E1,
+ 3.54937778887819891062E2,
+ 9.75708501743205489753E2,
+ 1.82390916687909736289E3,
+ 2.24633760818710981792E3,
+ 1.65666309194161350182E3,
+ 5.57535340817727675546E2
+ };
+
+ double R[] = {
+ 5.64189583547755073984E-1,
+ 1.27536670759978104416E0,
+ 5.01905042251180477414E0,
+ 6.16021097993053585195E0,
+ 7.40974269950448939160E0,
+ 2.97886665372100240670E0
+ };
+ double S[] = {
+ //1.00000000000000000000E0,
+ 2.26052863220117276590E0,
+ 9.39603524938001434673E0,
+ 1.20489539808096656605E1,
+ 1.70814450747565897222E1,
+ 9.60896809063285878198E0,
+ 3.36907645100081516050E0
+ };
+
+ if( a < 0.0 ) x = -a;
+ else x = a;
+
+ if( x < 1.0 ) return 1.0 - errorFunction(a);
+
+ z = -a * a;
+
+ if( z < -MAXLOG ) {
+ if( a < 0 ) return( 2.0 );
+ else return( 0.0 );
+ }
+
+ z = Math.exp(z);
+
+ if( x < 8.0 ) {
+ p = Polynomial.polevl( x, P, 8 );
+ q = Polynomial.p1evl( x, Q, 8 );
+ } else {
+ p = Polynomial.polevl( x, R, 5 );
+ q = Polynomial.p1evl( x, S, 6 );
+ }
+
+ y = (z * p)/q;
+
+ if( a < 0 ) y = 2.0 - y;
+
+ if( y == 0.0 ) {
+ if( a < 0 ) return 2.0;
+ else return( 0.0 );
+ }
+
+ return y;
+}
+/**
+ * Returns the integral from zero to x of the gamma probability
+ * density function.
+ *
+ * x
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * 0
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = Gamma.incompleteGamma( b, a*x ).
+ *
+ * @param a the paramater a (alpha) of the gamma distribution.
+ * @param b the paramater b (beta, lambda) of the gamma distribution.
+ * @param x integration end point.
+ */
+static public double gamma(double a, double b, double x ) {
+ if( x < 0.0 ) return 0.0;
+ return Gamma.incompleteGamma(b, a*x);
+}
+/**
+ * Returns the integral from x to infinity of the gamma
+ * probability density function:
+ *
+ * inf.
+ * b -
+ * a | | b-1 -at
+ * y = ----- | t e dt
+ * - | |
+ * | (b) -
+ * x
+ *
+ * The incomplete gamma integral is used, according to the
+ * relation
+ *
+ * y = Gamma.incompleteGammaComplement( b, a*x ).
+ *
+ * @param a the paramater a (alpha) of the gamma distribution.
+ * @param b the paramater b (beta, lambda) of the gamma distribution.
+ * @param x integration end point.
+ */
+static public double gammaComplemented(double a, double b, double x ) {
+ if( x < 0.0 ) return 0.0;
+ return Gamma.incompleteGammaComplement(b, a*x);
+}
+/**
+ * Returns the sum of the terms 0 through k of the Negative Binomial Distribution.
+ *
+ * k
+ * -- ( n+j-1 ) n j
+ * > ( ) p (1-p)
+ * -- ( j )
+ * j=0
+ *
+ * In a sequence of Bernoulli trials, this is the probability
+ * that k or fewer failures precede the n-th success.
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = negativeBinomial( k, n, p ) = Gamma.incompleteBeta( n, k+1, p ).
+ *
+ * All arguments must be positive,
+ * @param k end term.
+ * @param n the number of trials.
+ * @param p the probability of success (must be in (0.0,1.0)).
+ */
+static public double negativeBinomial(int k, int n, double p) {
+ if( (p < 0.0) || (p > 1.0) ) throw new IllegalArgumentException();
+ if(k < 0) return 0.0;
+
+ return Gamma.incompleteBeta( n, k+1, p );
+}
+/**
+ * Returns the sum of the terms k+1 to infinity of the Negative
+ * Binomial distribution.
+ *
+ * The terms are not computed individually; instead the incomplete
+ * beta integral is employed, according to the formula
+ *
+ * y = negativeBinomialComplemented( k, n, p ) = Gamma.incompleteBeta( k+1, n, 1-p ).
+ *
+ * All arguments must be positive,
+ * @param k end term.
+ * @param n the number of trials.
+ * @param p the probability of success (must be in (0.0,1.0)).
+ */
+static public double negativeBinomialComplemented(int k, int n, double p) {
+ if( (p < 0.0) || (p > 1.0) ) throw new IllegalArgumentException();
+ if(k < 0) return 0.0;
+
+ return Gamma.incompleteBeta( k+1, n, 1.0-p );
+}
+/**
+ * Returns the area under the Normal (Gaussian) probability density
+ * function, integrated from minus infinity to x (assumes mean is zero, variance is one).
+ *
+ * where z = x/sqrt(2).
+ * Computation is via the functions errorFunction and errorFunctionComplement.
+ */
+static public double normal( double a) throws ArithmeticException {
+ double x, y, z;
+
+ x = a * SQRTH;
+ z = Math.abs(x);
+
+ if( z < SQRTH ) y = 0.5 + 0.5 * errorFunction(x);
+ else {
+ y = 0.5 * errorFunctionComplemented(z);
+ if( x > 0 ) y = 1.0 - y;
+ }
+
+ return y;
+}
+/**
+ * Returns the area under the Normal (Gaussian) probability density
+ * function, integrated from minus infinity to x.
+ *
+ * where v = variance.
+ * Computation is via the functions errorFunction.
+ *
+ * @param mean the mean of the normal distribution.
+ * @param variance the variance of the normal distribution.
+ * @param x the integration limit.
+ */
+static public double normal(double mean, double variance, double x) throws ArithmeticException {
+ if (x>0)
+ return 0.5 + 0.5*errorFunction((x-mean)/Math.sqrt(2.0*variance));
+ else
+ return 0.5 - 0.5*errorFunction((-(x-mean))/Math.sqrt(2.0*variance));
+}
+/**
+ * Returns the value, x, for which the area under the
+ * Normal (Gaussian) probability density function (integrated from
+ * minus infinity to x) is equal to the argument y (assumes mean is zero, variance is one); formerly named ndtri.
+ *
+ * For small arguments 0 < y < exp(-2), the program computes
+ * z = sqrt( -2.0 * log(y) ); then the approximation is
+ * x = z - log(z)/z - (1/z) P(1/z) / Q(1/z).
+ * There are two rational functions P/Q, one for 0 < y < exp(-32)
+ * and the other for y up to exp(-2).
+ * For larger arguments,
+ * w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)).
+ *
+ */
+static public double normalInverse( double y0) throws ArithmeticException {
+ double x, y, z, y2, x0, x1;
+ int code;
+
+ final double s2pi = Math.sqrt(2.0*Math.PI);
+
+ if( y0 <= 0.0 ) throw new IllegalArgumentException();
+ if( y0 >= 1.0 ) throw new IllegalArgumentException();
+ code = 1;
+ y = y0;
+ if( y > (1.0 - 0.13533528323661269189) ) { /* 0.135... = exp(-2) */
+ y = 1.0 - y;
+ code = 0;
+ }
+
+ if( y > 0.13533528323661269189 ) {
+ y = y - 0.5;
+ y2 = y * y;
+ x = y + y * (y2 * Polynomial.polevl( y2, P0, 4)/Polynomial.p1evl( y2, Q0, 8 ));
+ x = x * s2pi;
+ return(x);
+ }
+
+ x = Math.sqrt( -2.0 * Math.log(y) );
+ x0 = x - Math.log(x)/x;
+
+ z = 1.0/x;
+ if( x < 8.0 ) /* y > exp(-32) = 1.2664165549e-14 */
+ x1 = z * Polynomial.polevl( z, P1, 8 )/Polynomial.p1evl( z, Q1, 8 );
+ else
+ x1 = z * Polynomial.polevl( z, P2, 8 )/Polynomial.p1evl( z, Q2, 8 );
+ x = x0 - x1;
+ if( code != 0 )
+ x = -x;
+ return( x );
+}
+/**
+ * Returns the sum of the first k terms of the Poisson distribution.
+ *
+ * k j
+ * -- -m m
+ * > e --
+ * -- j!
+ * j=0
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the relation
+ *
+ * y = poisson( k, m ) = Gamma.incompleteGammaComplement( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ * @param k number of terms.
+ * @param mean the mean of the poisson distribution.
+ */
+static public double poisson(int k, double mean) throws ArithmeticException {
+ if( mean < 0 ) throw new IllegalArgumentException();
+ if( k < 0 ) return 0.0;
+ return Gamma.incompleteGammaComplement((double)(k+1) ,mean);
+}
+/**
+ * Returns the sum of the terms k+1 to Infinity of the Poisson distribution.
+ *
+ * The terms are not summed directly; instead the incomplete
+ * gamma integral is employed, according to the formula
+ *
+ * y = poissonComplemented( k, m ) = Gamma.incompleteGamma( k+1, m ).
+ *
+ * The arguments must both be positive.
+ *
+ * @param k start term.
+ * @param mean the mean of the poisson distribution.
+ */
+static public double poissonComplemented(int k, double mean) throws ArithmeticException {
+ if( mean < 0 ) throw new IllegalArgumentException();
+ if( k < -1 ) return 0.0;
+ return Gamma.incompleteGamma((double)(k+1),mean);
+}
+/**
+ * Returns the integral from minus infinity to t of the Student-t
+ * distribution with k > 0 degrees of freedom.
+ *
+ * 1 - studentT(k,t) = 0.5 * Gamma.incompleteBeta( k/2, 1/2, z )
+ * where z = k/(k + t**2).
+ *
+ * Since the function is symmetric about t=0, the area under the
+ * right tail of the density is found by calling the function
+ * with -t instead of t.
+ *
+ * @param k degrees of freedom.
+ * @param t integration end point.
+ */
+static public double studentT(double k, double t) throws ArithmeticException {
+ if( k <= 0 ) throw new IllegalArgumentException();
+ if( t == 0 ) return( 0.5 );
+
+ double cdf = 0.5 * Gamma.incompleteBeta( 0.5*k, 0.5, k / (k + t * t) );
+
+ if (t >= 0) cdf = 1.0 - cdf; // fixes bug reported by stefan.bentink@molgen.mpg.de
+
+ return cdf;
+}
+/**
+ * Returns the value, t, for which the area under the
+ * Student-t probability density function (integrated from
+ * minus infinity to t) is equal to 1-alpha/2.
+ * The value returned corresponds to usual Student t-distribution lookup
+ * table for talpha[size].
+ *
+ * The function uses the studentT function to determine the return
+ * value iteratively.
+ *
+ * @param alpha probability
+ * @param size size of data set
+ */
+public static double studentTInverse(double alpha, int size) {
+ double cumProb = 1-alpha/2; // Cumulative probability
+ double f1,f2,f3;
+ double x1,x2,x3;
+ double g,s12;
+
+ cumProb = 1-alpha/2; // Cumulative probability
+ x1 = normalInverse(cumProb);
+
+ // Return inverse of normal for large size
+ if (size > 200) {
+ return x1;
+ }
+
+ // Find a pair of x1,x2 that braket zero
+ f1 = studentT(size,x1)-cumProb;
+ x2 = x1; f2 = f1;
+ do {
+ if (f1>0) {
+ x2 = x2/2;
+ } else {
+ x2 = x2+x1;
+ }
+ f2 = studentT(size,x2)-cumProb;
+ } while (f1*f2>0);
+
+ // Find better approximation
+ // Pegasus-method
+ do {
+ // Calculate slope of secant and t value for which it is 0.
+ s12 = (f2-f1)/(x2-x1);
+ x3 = x2 - f2/s12;
+
+ // Calculate function value at x3
+ f3 = studentT(size,x3)-cumProb;
+ if (Math.abs(f3)<1e-8) { // This criteria needs to be very tight!
+ // We found a perfect value -> return
+ return x3;
+ }
+
+ if (f3*f2<0) {
+ x1=x2; f1=f2;
+ x2=x3; f2=f3;
+ } else {
+ g = f2/(f2+f3);
+ f1=g*f1;
+ x2=x3; f2=f3;
+ }
+ } while(Math.abs(x2-x1)>0.001);
+
+ if (Math.abs(f2)<=Math.abs(f1)) {
+ return x2;
+ } else {
+ return x1;
+ }
+}
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasAccess2.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasAccess2.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasAccess2.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasAccess2.java 2010-05-17 04:27:36.000000000 +0000
@@ -0,0 +1,160 @@
+package org.mathpiper.builtin.library.jas;
+
+//------------------------------------------------------------------------
+// Factoring polynomials over Ring of Integer
+// Version for interfacing with MathPiper
+// (sherm experiments in here)
+//------------------------------------------------------------------------
+import java.util.Map;
+import java.util.SortedMap;
+import java.util.TreeMap;
+import java.util.List;
+import java.util.Set;
+import java.util.Iterator;
+
+import edu.jas.ufd.Factorization;
+import edu.jas.ufd.FactorFactory;
+import edu.jas.arith.BigInteger;
+import edu.jas.arith.BigRational;
+//import edu.jas.arith.BigComplex;
+import edu.jas.kern.ComputerThreads;
+import edu.jas.poly.GenPolynomial;
+import edu.jas.poly.GenPolynomialRing;
+import edu.jas.poly.TermOrder;
+import edu.jas.util.StringUtil;
+
+//-----------------------------------------------
+public class JasAccess2 {
+
+ private boolean debug = false;
+
+ private BigInteger bi;
+
+ private Factorization fEngineBI;
+
+ private GenPolynomial polyp;
+
+ public JasAccess2() {
+ // define the "nominal" BigInteger as type prototype
+ bi = new BigInteger(1);
+
+ // create a factorization engine suitable for BigInteger coefficient type
+ fEngineBI = FactorFactory.getImplementation(bi);
+
+ }//end constructor.
+
+
+
+ public Set factorPolyInt(String poly, String vars) {
+ if (debug) {
+ System.out.println(" poly = " + poly);
+ System.out.println(" vars = " + vars);
+ }
+
+ // convert string of variable names to array of strings as required
+ String[] jvars = StringUtil.variableList(vars);
+ int nvars = jvars.length;
+ if (debug) {
+ System.out.print("\n number of variables: ");
+ System.out.println(nvars);
+ for (int i = 0; i < nvars; i++) {
+ System.out.print(" " + jvars[i]);
+ }
+ System.out.println();
+ }
+
+ // make sure term-order is INVLEX, as required
+ //TermOrder to = new TermOrder(TermOrder.INVLEX);
+ //if (debug) {
+ // System.out.println(" term-order = " + to);
+ //}
+
+
+ Factorization fEngine = fEngineBI;
+ if (debug) {
+ System.out.println("\nFactorization: fEngineBI = " + fEngineBI);
+ }
+
+ // create appropriate Ring for BigIntegers with specified variable names
+ //GenPolynomialRing biRing = new GenPolynomialRing(bi, nvars, to, jvars);
+ GenPolynomialRing biRing = new GenPolynomialRing(bi, nvars, jvars);
+ if (debug) {
+ System.out.println("polynomial ring = " + biRing);
+ int nvars2 = biRing.nvar;
+ System.out.println(" number of variables for ring = " + nvars2);
+ String varNames = biRing.varsToString();
+ System.out.println(" names of variables for ring = " + varNames);
+ }
+
+ // --- Create polynomial in chosen Ring, from given string --
+ if (debug) {
+ System.out.println("\nstrPoly = " + poly);
+ }
+ polyp = biRing.parse(poly);
+ //System.out.println("\npoly = " + polyp);
+ if (debug) {
+ int lenPoly = polyp.length();
+ System.out.println(" length of poly = " + lenPoly);
+ int numVars = polyp.numberOfVariables();
+ System.out.println(" number of variables in poly = " + numVars);
+ long degree = polyp.degree();
+ System.out.println(" maximal degree of poly = " + degree);
+ }
+
+ // --- JasAccess the polynomial ---
+ SortedMap, Long> Sm = fEngineBI.factors(polyp);
+
+ // print info about factorization
+ /*int numFactors = Sm.size();
+ System.out.println(" number of factors: " + numFactors);
+ */
+
+ // --- Print out all factors and their multiplicities ---
+ /*for (Map.Entry, Long> f : Sm.entrySet()) {
+ GenPolynomial factor = f.getKey();
+ Long multiplicity = f.getValue();
+ System.out.println(" ( " + factor + " , " + multiplicity + " )");
+ }*/
+
+
+ return (Set) Sm.entrySet();
+
+
+ } // end method.
+
+
+
+ public long maxDegree() {
+ return this.polyp.degree();
+ } // end method
+
+
+ public void terminate()
+ {
+ ComputerThreads.terminate();
+ }
+
+ public boolean isDebug() {
+ return debug;
+ }
+
+ public void setDebug(boolean debug) {
+ this.debug = debug;
+ }
+
+
+
+ public static void main(String[] args) {
+ JasAccess2 jas = new JasAccess2();
+
+ jas.setDebug(true);
+
+ Set resultSet = jas.factorPolyInt("x**2-9", "x");
+
+ jas.terminate();
+
+ }//end main.
+
+
+}//end class.
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasAccess.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasAccess.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasAccess.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasAccess.java 2010-05-05 07:19:54.000000000 +0000
@@ -0,0 +1,151 @@
+package org.mathpiper.builtin.library.jas;
+
+//------------------------------------------------------------------------
+// Factoring polynomials over Ring of Integer
+// Version for interfacing with MathPiper
+//------------------------------------------------------------------------
+import java.util.Map;
+import java.util.SortedMap;
+import java.util.TreeMap;
+import java.util.List;
+import java.util.Set;
+import java.util.Iterator;
+
+import edu.jas.ufd.Factorization;
+import edu.jas.ufd.FactorFactory;
+import edu.jas.arith.BigInteger;
+import edu.jas.arith.BigRational;
+//import edu.jas.arith.BigComplex;
+import edu.jas.kern.ComputerThreads;
+import edu.jas.poly.GenPolynomial;
+import edu.jas.poly.GenPolynomialRing;
+import edu.jas.poly.TermOrder;
+import edu.jas.util.StringUtil;
+
+//-----------------------------------------------
+public class JasAccess {
+
+ private boolean debug = false;
+
+ private BigInteger bi;
+
+ private Factorization fEngineBI;
+
+ public JasAccess() {
+ // define the "nominal" BigInteger as type prototype
+ bi = new BigInteger(1);
+
+ // create a factorization engine suitable for BigInteger coefficient type
+ fEngineBI = FactorFactory.getImplementation(bi);
+
+ }//end constructor.
+
+
+
+ public Set factorPolyInt(String poly, String vars) {
+ if (debug) {
+ System.out.println(" poly = " + poly);
+ System.out.println(" vars = " + vars);
+ }
+
+ // convert string of variable names to array of strings as required
+ String[] jvars = StringUtil.variableList(vars);
+ int nvars = jvars.length;
+ if (debug) {
+ System.out.print("\n number of variables: ");
+ System.out.println(nvars);
+ for (int i = 0; i < nvars; i++) {
+ System.out.print(" " + jvars[i]);
+ }
+ System.out.println();
+ }
+
+ // make sure term-order is INVLEX, as required
+ TermOrder to = new TermOrder(TermOrder.INVLEX);
+ if (debug) {
+ System.out.println(" term-order = " + to);
+ }
+
+
+ Factorization fEngine = fEngineBI;
+ if (debug) {
+ System.out.println("\nFactorization: fEngineBI = " + fEngineBI);
+ }
+
+ // create appropriate Ring for BigIntegers with specified variable names
+ GenPolynomialRing biRing = new GenPolynomialRing(bi, nvars, to, jvars);
+ if (debug) {
+ System.out.println("polynomial ring = " + biRing);
+ int nvars2 = biRing.nvar;
+ System.out.println(" number of variables for ring = " + nvars2);
+ String varNames = biRing.varsToString();
+ System.out.println(" names of variables for ring = " + varNames);
+ }
+
+ // --- Create polynomial in chosen Ring, from given string --
+ if (debug) {
+ System.out.println("\nstrPoly = " + poly);
+ }
+ GenPolynomial polyp = biRing.parse(poly);
+ //System.out.println("\npoly = " + polyp);
+ if (debug) {
+ int lenPoly = polyp.length();
+ System.out.println(" length of poly = " + lenPoly);
+ int numVars = polyp.numberOfVariables();
+ System.out.println(" number of variables in poly = " + numVars);
+ long degree = polyp.degree();
+ System.out.println(" maximal degree of poly = " + degree);
+ }
+
+ // --- JasAccess the polynomial ---
+ SortedMap, Long> Sm = fEngineBI.factors(polyp);
+
+ // print info about factorization
+ /*int numFactors = Sm.size();
+ System.out.println(" number of factors: " + numFactors);
+ */
+
+ // --- Print out all factors and their multiplicities ---
+ /*for (Map.Entry, Long> f : Sm.entrySet()) {
+ GenPolynomial factor = f.getKey();
+ Long multiplicity = f.getValue();
+ System.out.println(" ( " + factor + " , " + multiplicity + " )");
+ }*/
+
+
+ return (Set) Sm.entrySet();
+
+
+ }//end method.
+
+
+
+ public void terminate()
+ {
+ ComputerThreads.terminate();
+ }
+
+ public boolean isDebug() {
+ return debug;
+ }
+
+ public void setDebug(boolean debug) {
+ this.debug = debug;
+ }
+
+
+
+ public static void main(String[] args) {
+ JasAccess jas = new JasAccess();
+
+ jas.setDebug(true);
+
+ Set resultSet = jas.factorPolyInt("x**2-9", "x");
+
+ jas.terminate();
+
+ }//end main.
+
+
+}//end class.
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasPolynomial.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasPolynomial.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JasPolynomial.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JasPolynomial.java 2010-06-08 16:46:22.000000000 +0000
@@ -0,0 +1,212 @@
+package org.mathpiper.builtin.library.jas;
+
+//------------------------------------------------------------------------
+// Operations on JAS Polynomials of various types
+// Version for interfacing with MathPiper
+// Initial version: 05/13/2010
+// Modifications: through 05/20/2010
+//------------------------------------------------------------------------
+import java.util.Collections;
+import java.util.Map;
+import java.util.SortedMap;
+import java.util.TreeMap;
+import java.util.List;
+import java.util.Set;
+import java.util.Iterator;
+
+import edu.jas.ufd.Factorization;
+import edu.jas.ufd.FactorFactory;
+import edu.jas.arith.BigInteger;
+import edu.jas.arith.BigRational;
+import edu.jas.arith.BigComplex;
+import edu.jas.kern.ComputerThreads;
+import edu.jas.poly.GenPolynomial;
+import edu.jas.poly.GenPolynomialRing;
+import edu.jas.poly.TermOrder;
+import edu.jas.util.StringUtil;
+
+//------------------------------------------------------------------------
+
+public class JasPolynomial {
+
+ private boolean debug = true;
+
+ private String ringName;
+
+ private BigInteger bint;
+ private BigRational brat;
+ private BigComplex bcmplx;
+
+ private GenPolynomialRing polyRing;
+ //private GenPolynomialRing polyRingExt;
+
+ private GenPolynomial poly;
+
+ private Factorization fEngine;
+
+ private SortedMap factorsMap;
+
+ // ----- CONSTRUCTORS -----
+
+ // no-argument constructor -- not to be used
+ protected JasPolynomial() {
+ }
+
+
+ // one-argument constructor -- specify polynomial Ring only
+ public JasPolynomial(String ringType) {
+ this(ringType,"x");
+ }
+
+
+ // two-argument constructor -- specify polynomial Ring and varaible-names string
+ // varNames string looks like this: "x,y"
+ public JasPolynomial(String ringType, String varNames) {
+ this(ringType,varNames,"x^2-1");
+ }
+
+
+ // three-argument constructor --
+ // specify polynomial Ring, varaible-names string, and polynomial string
+ // varNames string looks like this: "x,y"
+ // polyString looks like this: "3*x^2-5*x+4"
+ public JasPolynomial(String ringType, String varNames, String polyString) {
+ ringName = ringType;
+ String [] varList = varNames.split(",");
+ if (ringName.equals("Integer")) {
+ bint = new BigInteger(1);
+ GenPolynomialRing bintRing = new GenPolynomialRing(bint,varList);
+ polyRing = (GenPolynomialRing)bintRing;
+ poly = polyRing.parse(polyString);
+ fEngine = FactorFactory.getImplementation(bint);
+ }
+ else if ( ringName.equals("Rational")) {
+ brat = new BigRational(1);
+ GenPolynomialRing bratRing = new GenPolynomialRing(brat,varList);
+ polyRing = (GenPolynomialRing)bratRing;
+ poly = polyRing.parse(polyString);
+ fEngine = FactorFactory.getImplementation(brat);
+ }
+ else if ( ringName.equals("Complex")) {
+ bcmplx = new BigComplex(1);
+ GenPolynomialRing cmplxRing = new GenPolynomialRing(bcmplx,varList);
+ polyRing = (GenPolynomialRing)cmplxRing;
+ poly = polyRing.parse(polyString);
+ fEngine = FactorFactory.getImplementation(bcmplx);
+ }
+ }
+
+
+ // ------ ACCESSORS ------ ------ ------ ------ ------ ------
+
+ // Get
+
+ public boolean isDebug() {
+ return debug;
+ }
+
+ public GenPolynomialRing getRing() {
+ return polyRing;
+ }
+
+ public GenPolynomial getPolynomial() {
+ return poly;
+ }
+
+ public Factorization getFactorizationEngine() {
+ return fEngine;
+ }
+
+ public String getRingVariables() {
+ return polyRing.varsToString();
+ }
+
+ public boolean isIrreducible() {
+ return fEngine.isIrreducible(poly);
+ }
+
+ public boolean isIrreducible( GenPolynomial p ) {
+ return fEngine.isIrreducible(p);
+ }
+
+
+ // Set
+
+ public void setDebug(boolean debug) {
+ this.debug = debug;
+ }
+
+ public void addVars(String newVarsString) {
+ String[] newVars = newVarsString.split(",");
+ polyRing = polyRing.extend(newVars);
+ }
+
+ public void setPolynomial(String polyString) {
+ poly = polyRing.parse(polyString);
+ }
+
+ public void setPolynomial(String polyString, String newPolyVars) {
+ this.addVars(newPolyVars);
+ poly = polyRing.parse(polyString);
+ }
+
+
+
+ // Other ------ --------------- --------------- -----------------
+
+ // factorization of this.poly
+ public SortedMap factors() {
+ if ( debug ) {
+ System.out.println(" DEBUG: in method factors()");
+ System.out.flush();
+ }
+ factorsMap = fEngine.factors(poly);
+ if ( debug ) {
+ System.out.println(" map of factors: " + factorsMap);
+ System.out.flush();
+ }
+ return factorsMap;
+ }
+
+
+ // factorization of a new poly
+
+ public SortedMap factorNewPolynomial(String polyString) {
+ if ( debug ) {
+ System.out.println(" DEBUG: in method factorNewPolynomial1()");
+ System.out.flush();
+ }
+ setPolynomial(polyString);
+ if ( debug ) {
+ System.out.println("\n the poly was changed to: " + getPolynomial().toScript());
+ System.out.flush();
+ }
+ factorsMap = factors();
+ return factorsMap;
+ }
+
+
+ public SortedMap factorNewPolynomial(String polyString, String newPolyVars) {
+ if ( debug ) {
+ System.out.println(" DEBUG: in method factorNewPolynomial2()");
+ System.out.flush();
+ }
+ setPolynomial(polyString, newPolyVars);
+ if ( debug ) {
+ System.out.println("\n the poly was changed to: " + getPolynomial().toScript());
+ System.out.println(" the ring variables are " + getRing().varsToString());
+ System.out.flush();
+ }
+ factorsMap = factors();
+ return factorsMap;
+ }
+
+
+ // termination of all working threads
+ public void terminate(){
+ ComputerThreads.terminate();
+ }
+
+
+}//end class JasPolynomial
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JFactorsPolyInt.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JFactorsPolyInt.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/JFactorsPolyInt.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/JFactorsPolyInt.java 2010-05-30 17:01:32.000000000 +0000
@@ -0,0 +1,108 @@
+package org.mathpiper.builtin.library.jas;
+
+//------------------------------------------------------------------------
+// Factor Polynomial over Integers, using JAS Library
+// Version for interfacing with MathPiper
+// Initial version: 05/24/2010
+//------------------------------------------------------------------------
+import java.util.Collections;
+import java.util.Map;
+import java.util.SortedMap;
+import java.util.TreeMap;
+import java.util.List;
+import java.util.Set;
+import java.util.Iterator;
+
+import edu.jas.ufd.FactorInteger;
+import edu.jas.arith.BigInteger;
+import edu.jas.kern.ComputerThreads;
+import edu.jas.poly.GenPolynomial;
+import edu.jas.poly.GenPolynomialRing;
+import edu.jas.poly.TermOrder;
+import edu.jas.util.StringUtil;
+
+//------------------------------------------------------------------------
+
+public class JFactorsPolyInt {
+
+ private boolean debug = false;
+ private String ringName;
+ private BigInteger bint;
+ private GenPolynomialRing polyRing;
+ private GenPolynomial poly;
+ private FactorInteger fEngine;
+ private SortedMap factorsMap;
+
+ // ----- CONSTRUCTORS -----
+
+ // no-argument constructor -- not to be used
+ protected JFactorsPolyInt() {
+ }
+
+ // two-argument constructor --
+ // specify polynomial as string, and varaible-names as string
+ // polyString looks like this: "3*x^2-5*x+4"
+ // varNames string looks like this: "x,y"
+ public JFactorsPolyInt(String polyString, String varNames) {
+ if ( debug ) {
+ System.out.println("JFactorsPolyInt " + polyString + " " + varNames);
+ }
+ String [] varList = varNames.split(",");
+ bint = new BigInteger(1);
+ GenPolynomialRing bintRing = new GenPolynomialRing(bint,varList);
+ poly = bintRing.parse(polyString);
+ fEngine = new FactorInteger();
+ }
+
+
+ // factorization of this.poly
+ public SortedMap factors() {
+ factorsMap = fEngine.factors(poly);
+ return factorsMap;
+ }
+
+
+ // reducibility of this.poly
+ public boolean isReducible() {
+ return fEngine.isReducible(poly);
+ }
+
+
+ // termination of all working threads
+ public void terminate(){
+ ComputerThreads.terminate();
+ }
+
+/*
+ // M A I N
+ public static void main(String[] args) {
+
+ boolean iDebug = false;
+ long T1 = System.currentTimeMillis();
+
+ String polyString = args[0];
+ String varNames = args[1];
+
+ if ( iDebug ) {
+ System.out.println(" poly " + polyString);
+ System.out.println(" vars " + varNames);
+ System.out.flush();
+ }
+
+ JFactorsPolyInt jPoly = new JFactorsPolyInt(polyString,varNames);
+ SortedMap factorsMap = jPoly.factors();
+ System.out.println("\nfactorsMap: " + factorsMap);
+
+ System.out.println("\nisReducible: " + jPoly.isReducible());
+
+ jPoly.terminate();
+
+ long T2 = System.currentTimeMillis();
+ float elapsedTimeSec = (T2-T1)/1000F;
+ System.out.println(" elapsed time : " + elapsedTimeSec + " sec\n");
+
+ }
+*/
+
+}//end class JFactorsPolyInt
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/Ring.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/Ring.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jas/Ring.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jas/Ring.java 2010-04-09 07:47:11.000000000 +0000
@@ -0,0 +1,61 @@
+package org.mathpiper.builtin.library.jas;
+
+//Represents a JAS polynomial ring: GenPolynomialRing.
+import edu.jas.poly.GenPolynomialRing;
+import edu.jas.poly.GenPolynomialTokenizer;
+import edu.jas.poly.PolynomialList;
+import edu.jas.ufd.FactorAbstract;
+import edu.jas.ufd.FactorFactory;
+import edu.jas.ufd.GCDFactory;
+import edu.jas.ufd.GreatestCommonDivisorAbstract;
+import edu.jas.ufd.SquarefreeAbstract;
+import edu.jas.ufd.SquarefreeFactory;
+import java.io.StringReader;
+import java.util.List;
+import org.mathpiper.lisp.Environment;
+
+//Methods to create ideals and ideals with parametric coefficients.
+public class Ring {
+
+ private Environment iEnvironment;
+ private PolynomialList pset;
+ private GenPolynomialRing ring;
+ private GreatestCommonDivisorAbstract engine;
+ private SquarefreeAbstract sqf;
+ private FactorAbstract factor;
+
+ public Ring(Environment aEnvironment, String ringstr) throws Exception {
+
+ this.iEnvironment = aEnvironment;
+ StringReader sr = new StringReader(ringstr);
+ GenPolynomialTokenizer tok = new GenPolynomialTokenizer(sr);
+ pset = tok.nextPolynomialSet();
+ ring = pset.ring;
+
+ engine = GCDFactory.getProxy(ring.coFac);
+
+ sqf = SquarefreeFactory.getImplementation(ring.coFac);
+
+ factor = FactorFactory.getImplementation(ring.coFac);
+
+ }//end method.
+
+ public List gens() throws Exception {
+
+ /*
+ List genericPolynomials = ring.generators();
+ List returnList = new ArrayList();
+ for(GenPolynomial genericPolynomial: genericPolynomials)
+ {
+ returnList.add(new RingElem(genericPolynomial));
+ }*/
+
+ return ring.generators();
+
+ }
+}//end class.
+
+
+
+
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/AbstractMath.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/AbstractMath.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/AbstractMath.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/AbstractMath.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,12 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The AbstractMath superclass provides an abstract encapsulation of maths.
+* All classes with a postfix of Math should extend this class.
+* @version 1.0
+* @author Mark Hale
+*/
+public abstract class AbstractMath extends Object {
+ protected AbstractMath() {}
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/BetaDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/BetaDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/BetaDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/BetaDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,66 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The BetaDistribution class provides an object for encapsulating beta distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class BetaDistribution extends ProbabilityDistribution {
+ private double p,q;
+
+ /**
+ * Constructs a beta distribution.
+ * @param dgrP degrees of freedom p.
+ * @param dgrQ degrees of freedom q.
+ */
+ public BetaDistribution(double dgrP,double dgrQ) {
+ if(dgrP<=0 || dgrQ<=0)
+ throw new OutOfRangeException("The degrees of freedom must be greater than zero.");
+ p=dgrP;
+ q=dgrQ;
+ }
+ /**
+ * Returns the degrees of freedom p.
+ */
+ public double getDegreesOfFreedomP() {
+ return p;
+ }
+ /**
+ * Returns the degrees of freedom q.
+ */
+ public double getDegreesOfFreedomQ() {
+ return q;
+ }
+ /**
+ * Probability density function of a beta distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X);
+ if(X==0.0 || X==1.0)
+ return 0.0;
+ return Math.exp(-SpecialMath.logBeta(p,q)+(p-1.0)*Math.log(X)+(q-1.0)*Math.log(1.0-X));
+ }
+ /**
+ * Cumulative beta distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X);
+ return SpecialMath.incompleteBeta(X,p,q);
+ }
+ /**
+ * Inverse of the cumulative beta distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ if(probability==0.0)
+ return 0.0;
+ if(probability==1.0)
+ return 1.0;
+ return findRoot(probability, 0.5, 0.0, 1.0);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/BinomialDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/BinomialDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/BinomialDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/BinomialDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,80 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The BinomialDistribution class provides an object for encapsulating binomial distributions.
+* @version 0.1
+* @author Mark Hale
+*/
+public final class BinomialDistribution extends ProbabilityDistribution {
+ private int n;
+ private double p;
+
+ /**
+ * Constructs a binomial distribution.
+ * @param trials the number of trials.
+ * @param prob the probability.
+ */
+ public BinomialDistribution(int trials,double prob) {
+ if(trials<=0)
+ throw new OutOfRangeException("The number of trials should be (strictly) positive.");
+ n=trials;
+ if(prob<0.0 || prob>1.0)
+ throw new OutOfRangeException("The probability should be between 0 and 1.");
+ p=prob;
+ }
+ /**
+ * Returns the number of trials.
+ */
+ public int getTrialsParameter() {
+ return n;
+ }
+ /**
+ * Returns the probability.
+ */
+ public double getProbabilityParameter() {
+ return p;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return n*p;
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return n*p*(1.0-p);
+ }
+ /**
+ * Probability density function of a binomial distribution.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,n);
+ return ExtraMath.binomial(n,X)*Math.pow(p,X)*Math.pow(1.0-p,n-X);
+ }
+ /**
+ * Cumulative binomial distribution function.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,n);
+ double sum=0.0;
+ for(double i=0.0;i<=X;i++)
+ sum+=probability(i);
+ return sum;
+ }
+ /**
+ * Inverse of the cumulative binomial distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return Math.floor(findRoot(probability,n/2.0,0.0,n));
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/CauchyDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/CauchyDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/CauchyDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/CauchyDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,66 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The CauchyDistribution class provides an object for encapsulating Cauchy distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class CauchyDistribution extends ProbabilityDistribution {
+ private double alpha;
+ private double gamma;
+
+ /**
+ * Constructs the standard Cauchy distribution.
+ */
+ public CauchyDistribution() {
+ this(0.0,1.0);
+ }
+ /**
+ * Constructs a Cauchy distribution.
+ * @param location the location parameter.
+ * @param scale the scale parameter.
+ */
+ public CauchyDistribution(double location,double scale) {
+ if(scale<0.0)
+ throw new OutOfRangeException("The scale parameter should be positive.");
+ alpha=location;
+ gamma=scale;
+ }
+ /**
+ * Returns the location parameter.
+ */
+ public double getLocationParameter() {
+ return alpha;
+ }
+ /**
+ * Returns the scale parameter.
+ */
+ public double getScaleParameter() {
+ return gamma;
+ }
+ /**
+ * Probability density function of a Cauchy distribution.
+ * P(X) = /((2+(X-)2)).
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ final double y=X-alpha;
+ return gamma/(Math.PI*(gamma*gamma+y*y));
+ }
+ /**
+ * Cumulative Cauchy distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ return 0.5+Math.atan((X-alpha)/gamma)/Math.PI;
+ }
+ /**
+ * Inverse of the cumulative Cauchy distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return alpha-gamma/Math.tan(Math.PI*probability);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,56 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The ChiSqrDistribution class provides an object for encapsulating chi-squared distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class ChiSqrDistribution extends ProbabilityDistribution {
+ private double r;
+// The ChiSqr and Gamma distributions are closely related.
+ private GammaDistribution gamma;
+
+ /**
+ * Constructs a chi-squared distribution.
+ * @param dgr degrees of freedom.
+ */
+ public ChiSqrDistribution(double dgr) {
+ if(dgr<=0.0)
+ throw new OutOfRangeException("The degrees of freedom must be greater than zero.");
+ r=dgr;
+ gamma=new GammaDistribution(0.5*r);
+ }
+ /**
+ * Returns the degrees of freedom.
+ */
+ public double getDegreesOfFreedom() {
+ return r;
+ }
+ /**
+ * Probability density function of a chi-squared distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ return 0.5*gamma.probability(0.5*X);
+ }
+ /**
+ * Cumulative chi-squared distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return SpecialMath.incompleteGamma(0.5*r,0.5*X);
+ }
+ /**
+ * Inverse of the cumulative chi-squared distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ if(probability==1.0)
+ return Double.MAX_VALUE;
+ else
+ return 2.0*gamma.inverse(probability);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,80 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The ExponentialDistribution class provides an object for encapsulating exponential distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class ExponentialDistribution extends ProbabilityDistribution {
+ private double lambda;
+
+ /**
+ * Constructs the standard exponential distribution.
+ */
+ public ExponentialDistribution() {
+ this(1.0);
+ }
+ /**
+ * Constructs an exponential distribution.
+ * @param decay the scale parameter.
+ */
+ public ExponentialDistribution(double decay) {
+ if(decay<0.0)
+ throw new OutOfRangeException("The scale parameter should be positive.");
+ lambda=decay;
+ }
+ /**
+ * Constructs an exponential distribution from a data set.
+ * @param array a sample.
+ */
+ public ExponentialDistribution(double array[]) {
+ double sumX=array[0];
+ for(int i=1;ie-X.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return lambda*Math.exp(-lambda*X);
+ }
+ /**
+ * Cumulative exponential distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return 1.0-Math.exp(-lambda*X);
+ }
+ /**
+ * Inverse of the cumulative exponential distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return -Math.log(1.0-probability)/lambda;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,346 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+ * The extra math library.
+ * Provides extra functions not in java.lang.Math class.
+ * This class cannot be subclassed or instantiated because all methods are static.
+ * @version 1.2
+ * @author Mark Hale
+ */
+public final class ExtraMath extends AbstractMath {
+ private ExtraMath() {}
+
+ /**
+ * Rounds a number to so many significant figures.
+ * @param x a number to be rounded.
+ * @param significant number of significant figures to round to.
+ */
+ public static double round(final double x, final int significant) {
+ if(x == 0.0)
+ return x;
+ else if(significant == 0)
+ return 0.0;
+ final double signedExp = log10(Math.abs(x)) - significant;
+ if(signedExp < 0.0) {
+ // keep the exponent positive so factor is representable
+ final double factor = Math.pow(10.0, Math.floor(-signedExp));
+ return Math.round(x*factor)/factor;
+ } else {
+ final double factor = Math.pow(10.0, Math.ceil(signedExp));
+ return Math.round(x/factor)*factor;
+ }
+ }
+ /**
+ * Returns a random number within a specified range.
+ */
+ public static double random(double min, double max) {
+ return (max-min)*Math.random()+min;
+ }
+ /**
+ * Returns the sign of a number.
+ * @return 1 if x>0.0, -1 if x<0.0, else 0.
+ */
+ public static int sign(double x) {
+ if(x > 0.0)
+ return 1;
+ else if(x < 0.0)
+ return -1;
+ else
+ return 0;
+ }
+ /**
+ * Returns sqrt(x2+y2).
+ */
+ public static double hypot(final double x,final double y) {
+ final double xAbs=Math.abs(x);
+ final double yAbs=Math.abs(y);
+ if(xAbs==0.0 && yAbs==0.0)
+ return 0.0;
+ else if(xAbsb.
+ * @param a an integer.
+ * @param b a positive integer.
+ */
+ public static int pow(int a, int b) {
+ if(b < 0) {
+ throw new IllegalArgumentException(b+" must be a positive integer.");
+ } else if(b == 0) {
+ return 1;
+ } else {
+ if(a == 0) {
+ return 0;
+ } else if(a == 1) {
+ return 1;
+ } else if(a == 2) {
+ return 1<a.
+ * @param a a positive integer.
+ */
+ public static int pow2(int a) {
+ return 1<double value.
+ *
The identity is:
+ *
coth(x) = (ex + e-x)/(ex - e-x),
+
+ * in other words, {@linkplain Math#cosh cosh(x)}/{@linkplain Math#sinh sinh(x)}.
+ *
Special cases:
+ *
+ *
If the argument is NaN, then the result is NaN.
+ *
If the argument is zero, then the result is an infinity with the same sign as the argument.
+ *
If the argument is positive infinity, then the result is +1.0.
+ *
If the argument is negative infinity, then the result is -1.0.
+ *
+ * @param x The number whose hyperbolic cotangent is sought
+ * @return The hyperbolic cotangent of x
+ */
+ public static double
+ coth(double x) {
+ return 1.0D/tanh(x);
+ } //coth
+
+ /**
+ * Returns the hyperbolic cosecant of a double value.
+ *
The identity is:
+ *
csch(x) = (2/(ex - e-x),
+ * in other words, 1/{@linkplain Math#sinh sinh(x)}.
+ *
Special cases:
+ *
+ *
If the argument is NaN, then the result is NaN.
+ *
If the argument is zero, then the result is an infinity with the same sign as the argument.
+ *
If the argument is positive infinity, then the result is +0.0.
+ *
If the argument is negative infinity, then the result is -0.0.
+ *
+ * @param x The number whose hyperbolic cosecant is sought
+ * @return The hyperbolic cosecant of x
+ */
+ public static double
+ csch(double x) {
+ return 1.0D/sinh(x);
+ } //csch
+
+ /**
+ * Returns the hyperbolic secant of a double value.
+ *
The identity is:
+ *
sech(x) = (2/(ex + e-x),
+ * in other words, 1/{@linkplain Math#cosh cosh(x)}.
+ *
Special cases:
+ *
+ *
If the argument is NaN, then the result is NaN.
+ *
If the argument is an infinity (positive or negative), then the result is +0.0.
+ *
+ * @param x The number whose hyperbolic secant is sought
+ * @return The hyperbolic secant of x
+ */
+ public static double
+ sech(double x) {
+ return 1.0D/cosh(x);
+ } //sech
+
+ /**
+ * Returns the inverse hyperbolic sine of a double value.
+ *
The identity is:
+ *
asinh(x) = ln(x + sqrt(x2 + 1))
+ *
Special cases:
+ *
+ *
If the argument is NaN, then the result is NaN.
+ *
If the argument is infinite, then the result is an infinity with the same sign as the argument.
+ *
If the argument is zero, then the result is a zero with the same sign as the argument.
+ *
+ * @param x The number whose inverse hyperbolic sine is sought
+ * @return The inverse hyperbolic sine of x
+ */
+ public static double
+ asinh(double x) {
+ //Math.hypot(Double.NEGATIVE_INFINITY, 1.0D) is Double.POSITIVE_INFINITY
+ //return Double.isInfinite(x) ? x : (x == 0.0) ? x : Math.log(x + Math.hypot(x, 1.0D));
+ return Double.isInfinite(x) ? x : (x == 0.0) ? x : Math.log(x+Math.sqrt(x*x+1.0));
+ } //asinh
+
+ /**
+ * Returns the inverse hyperbolic cosine of a double value.
+ * Note that cosh(�acosh(x)) = x; this function arbitrarily returns the positive branch.
+ *
The identity is:
+ *
acosh(x) = ln(x � sqrt(x2 - 1))
+ *
Special cases:
+ *
+ *
If the argument is NaN or less than one, then the result is NaN.
+ *
If the argument is a positive infinity, then the result is (positive) infinity.
+ *
If the argument is one, then the result is (positive) zero.
+ *
+ * @param x The number whose inverse hyperbolic cosine is sought
+ * @return The inverse hyperbolic cosine of x
+ */
+ public static double
+ acosh(double x) {
+ return Math.log(x + Math.sqrt(x*x - 1.0D));
+ } //acosh
+
+ /**
+ * Returns the inverse hyperbolic tangent of a double value.
+ *
The identity is:
+ *
atanh(x) = (1/2)*ln((1 + x)/(1 - x))
+ *
Special cases:
+ *
+ *
If the argument is NaN, an infinity, or has a modulus of greater than one, then the result is NaN.
+ *
If the argument is plus or minus one, then the result is infinity with the same sign as the argument.
+ *
If the argument is zero, then the result is a zero with the same sign as the argument.
+ *
+ * @param x A double specifying the value whose inverse hyperbolic tangent is sought
+ * @return A double specifying the inverse hyperbolic tangent of x
+ */
+ public static double
+ atanh(double x) {
+ //return (Math.log1p(x) - Math.log1p(-x))/2.0D;
+ return (x != 0.0) ? (Math.log(1.0D + x)-Math.log(1.0D - x))/2.0D : x;
+ } //atanh
+
+ /**
+ * Returns the inverse hyperbolic cotangent of a double value.
+ *
The identity is:
+ *
acoth(x) = (1/2)*ln((x + 1)/(x - 1))
+ *
Special cases:
+ *
+ *
If the argument is NaN or a modulus of less than one, then the result is NaN.
+ *
If the argument is an infinity, then the result is zero with the same sign as the argument.
+ *
If the argument is plus or minus one, then the result is infinity with the same sign as the argument.
+ *
+ * @param x The number whose inverse hyperbolic cotangent is sought
+ * @return The inverse hyperbolic cotangent of x
+ */
+ public static double
+ acoth(double x) {
+// return (Math.log1p(x) - Math.log(x - 1.0D))/2.0D; // Difference of two same-sign infinities is NaN
+ if (Double.isInfinite(x)) return (x < 0.0) ? -0.0D : +0.0D;
+ //return (x == -1.0D) ? Double.NEGATIVE_INFINITY : (Math.log1p(x) - Math.log(x - 1.0D))/2.0D;
+ return (x == -1.0D) ? Double.NEGATIVE_INFINITY : (Math.log(x+1.0) - Math.log(x - 1.0D))/2.0D;
+ } //acoth
+
+ /**
+ * Returns the inverse hyperbolic cosecant of a double value.
+ *
The identity is:
+ *
acsch(x) = ln((1 - sqrt(1 + x2))/x) for x < 0;
+ *
acsch(x) = ln((1 + sqrt(1 + x2))/x) for x > 0.
+ *
Special cases:
+ *
+ *
If the argument is NaN, then the result is NaN.
+ *
If the argument is an infinity, then the result is zero with the same sign as the argument.
+ *
If the argument is zero, then the result is infinity with the same sign as the argument.
+ *
+ * @param x The number whose inverse hyperbolic cosecant is sought
+ * @return The inverse hyperbolic cosecant of x
+ */
+ public static double
+ acsch(double x) {
+// return (x < 0) ? Math.log((1.0D - Math.sqrt(Math.hypot(1.0, x)))/x) : Math.log((1.0D + Math.sqrt(1.0, x))/x);
+
+ if (Double.isInfinite(x)) return (x < 0.0) ? -0.0D : +0.0D;
+ //log(+infinity) is +infinity, but log(-infinity) is NaN
+ return (x == 0.0D) ? 1.0/x : Math.log((1.0D + sign(x)*Math.sqrt(x*x+1.0))/x);
+ } //acsch
+
+ /**
+ * Returns the inverse hyperbolic secant of a double value.
+ * Note that sech(�asech(x)) = x; this function arbitrarily returns the positive branch.
+ *
The identity is:
+ *
asech(x) = ln((1 + sqrt(1 - x2))/x).
+ *
Special cases:
+ *
+ *
If the argument is NaN, less than zero, or greater than one, then the result is NaN.
+ *
If the argument is zero, then the result is infinity with the same sign as the argument.
+ *
+ * @param x The number whose hyperbolic secant is sought
+ * @return The hyperbolic secant of x
+ */
+ public static double
+ asech(double x) {
+ //log(+infinity) is +infinity, but log(-infinity) is NaN
+ return (x == 0.0D) ? 1.0/x : Math.log((1.0D + Math.sqrt(1.0D - x*x))/x);
+ } //asech
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/FDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/FDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/FDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/FDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,73 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The FDistribution class provides an object for encapsulating F-distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class FDistribution extends ProbabilityDistribution {
+ private double p,q;
+// We make use of the fact that when x has an F-distibution then
+// y = p*x/(q+p*x) has a beta distribution with parameters p/2 and q/2.
+ private BetaDistribution beta;
+
+ /**
+ * Constructs an F-distribution.
+ * @param dgrP degrees of freedom p.
+ * @param dgrQ degrees of freedom q.
+ */
+ public FDistribution(double dgrP, double dgrQ) {
+ if(dgrP<=0.0 || dgrQ<=0.0)
+ throw new OutOfRangeException("The degrees of freedom must be greater than zero.");
+ p=dgrP;
+ q=dgrQ;
+ beta=new BetaDistribution(p/2.0, q/2.0);
+ }
+ /**
+ * Returns the degrees of freedom p.
+ */
+ public double getDegreesOfFreedomP() {
+ return p;
+ }
+ /**
+ * Returns the degrees of freedom q.
+ */
+ public double getDegreesOfFreedomQ() {
+ return q;
+ }
+ /**
+ * Probability density function of an F-distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ final double y = q/(q+(p*X));
+ return beta.probability(1.0-y)*y*y*p/q;
+ }
+ /**
+ * Cumulative F-distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return beta.cumulative((p*X)/(q+(p*X)));
+ }
+ /**
+ * Inverse of the cumulative F-distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ if(probability==0.0)
+ return 0.0;
+ if(probability==1.0)
+ return Double.MAX_VALUE;
+ final double y=beta.inverse(probability);
+ if(y<2.23e-308) //avoid overflow
+ return Double.MAX_VALUE;
+ else
+ return (q/p)*(y/(1.0-y));
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/GammaDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/GammaDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/GammaDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/GammaDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,72 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The GammaDistribution class provides an object for encapsulating gamma distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class GammaDistribution extends ProbabilityDistribution {
+ private double shape;
+
+ /**
+ * Constructs a gamma distribution.
+ * @param s the shape parameter.
+ */
+ public GammaDistribution(double s) {
+ if(s<=0.0)
+ throw new OutOfRangeException("The shape parameter should be (strictly) positive.");
+ shape=s;
+ }
+ /**
+ * Returns the shape parameter.
+ */
+ public double getShapeParameter() {
+ return shape;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return shape;
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return shape;
+ }
+ /**
+ * Probability density function of a gamma distribution.
+ * P(X) = Xs-1 e-X/(s).
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ if(X==0.0)
+ return 0.0;
+ else
+ return Math.exp(-SpecialMath.logGamma(shape)-X+(shape-1)*Math.log(X));
+ }
+ /**
+ * Cumulative gamma distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return SpecialMath.incompleteGamma(shape,X);
+ }
+ /**
+ * Inverse of the cumulative gamma distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ if(probability==0.0)
+ return 0.0;
+ if(probability==1.0)
+ return Double.MAX_VALUE;
+ return findRoot(probability, shape, 0.0, Double.MAX_VALUE);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/GeometricDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/GeometricDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/GeometricDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/GeometricDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,68 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The GeometricDistribution class provides an object for encapsulating geometric distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class GeometricDistribution extends ProbabilityDistribution {
+ private double success;
+ private double failure;
+
+ /**
+ * Constructs a geometric distribution.
+ * @param prob the probability of success.
+ */
+ public GeometricDistribution(double prob) {
+ if(prob<0.0 || prob>1.0)
+ throw new OutOfRangeException("The probability should be between 0.0 and 1.0.");
+ success=prob;
+ failure=1.0-prob;
+ }
+ /**
+ * Returns the success parameter.
+ */
+ public double getSuccessParameter() {
+ return success;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return 1.0/success;
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return failure/(success*success);
+ }
+ /**
+ * Probability density function of a geometric distribution.
+ * P(X) = p (1-p)X-1.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return success*Math.pow(failure,X-1);
+ }
+ /**
+ * Cumulative geometric distribution function.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return 1.0-Math.pow(failure,X);
+ }
+ /**
+ * Inverse of the cumulative geometric distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return Math.log(1.0-probability)/Math.log(failure);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/LognormalDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/LognormalDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/LognormalDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/LognormalDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,61 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The LognormalDistribution class provides an object for encapsulating lognormal distributions.
+* @version 0.1
+* @author Mark Hale
+*/
+public final class LognormalDistribution extends ProbabilityDistribution {
+ private NormalDistribution normal;
+
+ /**
+ * Constructs a standard lognormal distribution.
+ */
+ public LognormalDistribution() {
+ this(0.0,1.0);
+ }
+ /**
+ * Constructs a lognormal distribution.
+ * @param mu the mu parameter.
+ * @param sigma the sigma parameter.
+ */
+ public LognormalDistribution(double mu,double sigma) {
+ normal=new NormalDistribution(mu,sigma*sigma);
+ }
+ /**
+ * Returns the mu parameter.
+ */
+ public double getMuParameter() {
+ return normal.getMean();
+ }
+ /**
+ * Returns the sigma parameter.
+ */
+ public double getSigmaParameter() {
+ return Math.sqrt(normal.getVariance());
+ }
+ /**
+ * Probability density function of a lognormal distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return normal.probability(Math.log(X))/X;
+ }
+ /**
+ * Cumulative lognormal distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return normal.cumulative(Math.log(X));
+ }
+ /**
+ * Inverse of the cumulative lognormal distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ return Math.exp(normal.inverse(probability));
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/NormalDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/NormalDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/NormalDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/NormalDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,103 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The NormalDistribution class provides an object for encapsulating normal distributions.
+* @version 1.1
+* @author Jaco van Kooten
+*/
+public final class NormalDistribution extends ProbabilityDistribution implements NumericalConstants {
+ private double mean,variance;
+ private double pdfDenominator,cdfDenominator;
+
+ /**
+ * Constructs the standard normal distribution (zero mean and unity variance).
+ */
+ public NormalDistribution() {
+ this(0.0,1.0);
+ }
+ /**
+ * Constructs a normal distribution.
+ * @param mu the mean.
+ * @param var the variance.
+ */
+ public NormalDistribution(double mu,double var) {
+ mean=mu;
+ if(var<=0.0)
+ throw new OutOfRangeException("The variance should be (strictly) positive.");
+ variance=var;
+ pdfDenominator=SQRT2PI*Math.sqrt(variance);
+ cdfDenominator=SQRT2*Math.sqrt(variance);
+ }
+ /**
+ * Constructs a normal distribution from a data set.
+ * @param array a sample.
+ * @author Mark Hale
+ */
+ public NormalDistribution(double array[]) {
+ double sumX=array[0];
+ double sumX2=array[0]*array[0];
+ for(int i=1;i.
+ * @jsci.planetmath Pi
+ */
+ double TWO_PI=6.2831853071795864769252867665590057683943387987502;
+ /**
+ * Square root of 2.
+ */
+ double SQRT2PI=2.5066282746310005024157652848110452530069867406099;
+ /**
+ * Natural logarithm of 10.
+ */
+ double LOG10=2.30258509299404568401799145468436420760110148862877;
+ /**
+ * Euler's gamma constant.
+ * @jsci.planetmath EulersConstant
+ */
+ double GAMMA=0.57721566490153286060651209008240243104215933593992;
+ /**
+ * Golden ratio.
+ * @jsci.planetmath GoldenRatio
+ */
+ double GOLDEN_RATIO=1.6180339887498948482045868343656381177203091798058;
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,21 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* This exception occurs if an argument in a statistics function is out-of-range.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public class OutOfRangeException extends IllegalArgumentException {
+ /**
+ * Constructs an OutOfRangeException with no detail message.
+ */
+ public OutOfRangeException() {
+ }
+ /**
+ * Constructs an OutOfRangeException with the specified detail message.
+ */
+ public OutOfRangeException(String s) {
+ super(s);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,77 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The ParetoDistribution class provides an object for encapsulating Pareto distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class ParetoDistribution extends ProbabilityDistribution {
+ private double shape;
+ private double scale;
+
+ /**
+ * Constructs a Pareto distribution.
+ * @param sh the shape.
+ * @param sc the scale.
+ */
+ public ParetoDistribution(double sh,double sc) {
+ if(sh<0.0)
+ throw new OutOfRangeException("The shape parameter should be positive.");
+ shape=sh;
+ if(sc<0.0)
+ throw new OutOfRangeException("The scale paremeter should be positive.");
+ scale=sc;
+ }
+ /**
+ * Returns the shape parameter.
+ */
+ public double getShapeParameter() {
+ return shape;
+ }
+ /**
+ * Returns the scale parameter.
+ */
+ public double getScaleParameter() {
+ return scale;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return shape*scale/(shape-1.0);
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return shape*scale*scale/((shape-2.0)*(shape-1.0)*(shape-1.0));
+ }
+ /**
+ * Probability density function of a Pareto distribution.
+ * P(X) = (a/X) (s/X)a.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ if(XXe-/X!.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return Math.exp(X*Math.log(lambda)-lambda-ExtraMath.logFactorial(X));
+ }
+ /**
+ * Cumulative Poisson distribution function.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ double sum=0.0;
+ for(double i=0.0;i<=X;i++)
+ sum+=probability(i);
+ return sum;
+ }
+ /**
+ * Inverse of the cumulative Poisson distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return Math.round(findRoot(probability,lambda,0.0,Double.MAX_VALUE));
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ProbabilityDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ProbabilityDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ProbabilityDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ProbabilityDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,83 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The ProbabilityDistribution superclass provides an object for encapsulating probability distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public abstract class ProbabilityDistribution extends Object {
+ /**
+ * Constructs a probability distribution.
+ */
+ public ProbabilityDistribution() {}
+ /**
+ * Probability density function.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public abstract double probability(double X);
+ /**
+ * Cumulative distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public abstract double cumulative(double X);
+ /**
+ * Inverse of the cumulative distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public abstract double inverse(double probability);
+ /**
+ * Check if the range of the argument of the distribution method is between lo and hi.
+ * @exception OutOfRangeException If the argument is out of range.
+ */
+ protected final void checkRange(double x, double lo, double hi) {
+ if(xhi)
+ throw new OutOfRangeException("The argument of the distribution method should be between "+lo+" and "+hi+".");
+ }
+ /**
+ * Check if the range of the argument of the distribution method is between 0.0 and 1.0.
+ * @exception OutOfRangeException If the argument is out of range.
+ */
+ protected final void checkRange(double x) {
+ if(x<0.0 || x>1.0)
+ throw new OutOfRangeException("The argument of the distribution method should be between 0.0 and 1.0.");
+ }
+
+ private static final double FINDROOT_ACCURACY = 1.0e-15;
+ private static final int FINDROOT_MAX_ITERATIONS = 150;
+ /**
+ * This method approximates the value of X for which P(x<X)=prob.
+ * It applies a combination of a Newton-Raphson procedure and bisection method
+ * with the value guess as a starting point. Furthermore, to ensure convergency
+ * and stability, one should supply an inverval [xLo,xHi] in which the probalility
+ * distribution reaches the value prob. The method does no checking, it will produce
+ * bad results if wrong values for the parameters are supplied - use it with care.
+ */
+ protected final double findRoot(double prob,double guess,double xLo,double xHi) {
+ double x=guess,xNew=guess;
+ double error,pdf,dx=1.0;
+ int i=0;
+ while(Math.abs(dx)>FINDROOT_ACCURACY && i++xHi || pdf==0.0) {
+ xNew=(xLo+xHi)/2.0;
+ dx=xNew-x;
+ }
+ x=xNew;
+ }
+ return x;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/SpecialMath.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/SpecialMath.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/SpecialMath.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/SpecialMath.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,1564 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The special function math library.
+* This class cannot be subclassed or instantiated because all methods are static.
+* @version 1.2
+* @author Mark Hale
+*/
+public final class SpecialMath extends AbstractMath implements NumericalConstants {
+ private SpecialMath() {}
+
+// Some IEEE machine constants
+ /**
+ * Relative machine precision.
+ */
+ private final static double EPS=2.22e-16;
+ /**
+ * The smallest positive floating-point number such that 1/xminin is machine representable.
+ */
+ private final static double XMININ=2.23e-308;
+
+
+// CHEBYSHEV SERIES
+
+// series for ai0 on the interval 1.25000d-01 to 3.33333d-01
+// with weighted error 7.87e-17
+// log weighted error 16.10
+// significant figures required 14.69
+// decimal places required 16.76
+
+ private final static double ai0cs[]={
+ 0.07575994494023796,
+ 0.00759138081082334,
+ 0.00041531313389237,
+ 0.00001070076463439,
+ -0.00000790117997921,
+ -0.00000078261435014,
+ 0.00000027838499429,
+ 0.00000000825247260,
+ -0.00000001204463945,
+ 0.00000000155964859,
+ 0.00000000022925563,
+ -0.00000000011916228,
+ 0.00000000001757854,
+ 0.00000000000112822,
+ -0.00000000000114684,
+ 0.00000000000027155,
+ -0.00000000000002415,
+ -0.00000000000000608,
+ 0.00000000000000314,
+ -0.00000000000000071,
+ 0.00000000000000007};
+
+// series for ai02 on the interval 0. to 1.25000d-01
+// with weighted error 3.79e-17
+// log weighted error 16.42
+// significant figures required 14.86
+// decimal places required 17.09
+ private final static double ai02cs[]={
+ 0.05449041101410882,
+ 0.00336911647825569,
+ 0.00006889758346918,
+ 0.00000289137052082,
+ 0.00000020489185893,
+ 0.00000002266668991,
+ 0.00000000339623203,
+ 0.00000000049406022,
+ 0.00000000001188914,
+ -0.00000000003149915,
+ -0.00000000001321580,
+ -0.00000000000179419,
+ 0.00000000000071801,
+ 0.00000000000038529,
+ 0.00000000000001539,
+ -0.00000000000004151,
+ -0.00000000000000954,
+ 0.00000000000000382,
+ 0.00000000000000176,
+ -0.00000000000000034,
+ -0.00000000000000027,
+ 0.00000000000000003};
+
+// series for ai1 on the interval 1.25000d-01 to 3.33333d-01
+// with weighted error 6.98e-17
+// log weighted error 16.16
+// significant figures required 14.53
+// decimal places required 16.82
+
+ private final static double ai1cs[]={
+ -0.02846744181881479,
+ -0.01922953231443221,
+ -0.00061151858579437,
+ -0.00002069971253350,
+ 0.00000858561914581,
+ 0.00000104949824671,
+ -0.00000029183389184,
+ -0.00000001559378146,
+ 0.00000001318012367,
+ -0.00000000144842341,
+ -0.00000000029085122,
+ 0.00000000012663889,
+ -0.00000000001664947,
+ -0.00000000000166665,
+ 0.00000000000124260,
+ -0.00000000000027315,
+ 0.00000000000002023,
+ 0.00000000000000730,
+ -0.00000000000000333,
+ 0.00000000000000071,
+ -0.00000000000000006};
+
+// series for ai12 on the interval 0. to 1.25000d-01
+// with weighted error 3.55e-17
+// log weighted error 16.45
+// significant figures required 14.69
+// decimal places required 17.12
+
+ private final static double ai12cs[]={
+ 0.02857623501828014,
+ -0.00976109749136147,
+ -0.00011058893876263,
+ -0.00000388256480887,
+ -0.00000025122362377,
+ -0.00000002631468847,
+ -0.00000000383538039,
+ -0.00000000055897433,
+ -0.00000000001897495,
+ 0.00000000003252602,
+ 0.00000000001412580,
+ 0.00000000000203564,
+ -0.00000000000071985,
+ -0.00000000000040836,
+ -0.00000000000002101,
+ 0.00000000000004273,
+ 0.00000000000001041,
+ -0.00000000000000382,
+ -0.00000000000000186,
+ 0.00000000000000033,
+ 0.00000000000000028,
+ -0.00000000000000003};
+
+// series for aif on the interval -1.00000d+00 to 1.00000d+00
+// with weighted error 1.09e-19
+// log weighted error 18.96
+// significant figures required 17.76
+// decimal places required 19.44
+
+ private final static double aifcs[]={
+ -0.03797135849666999750,
+ 0.05919188853726363857,
+ 0.00098629280577279975,
+ 0.00000684884381907656,
+ 0.00000002594202596219,
+ 0.00000000006176612774,
+ 0.00000000000010092454,
+ 0.00000000000000012014,
+ 0.00000000000000000010};
+
+// series for aig on the interval -1.00000d+00 to 1.00000d+00
+// with weighted error 1.51e-17
+// log weighted error 16.82
+// significant figures required 15.19
+// decimal places required 17.27
+
+ private final static double aigcs[]={
+ 0.01815236558116127,
+ 0.02157256316601076,
+ 0.00025678356987483,
+ 0.00000142652141197,
+ 0.00000000457211492,
+ 0.00000000000952517,
+ 0.00000000000001392,
+ 0.00000000000000001};
+
+// series for aip on the interval 0. to 1.00000d+00
+// with weighted error 5.10e-17
+// log weighted error 16.29
+// significant figures required 14.41
+// decimal places required 17.06
+
+ private final static double aipcs[]={
+ -0.0187519297793868,
+ -0.0091443848250055,
+ 0.0009010457337825,
+ -0.0001394184127221,
+ 0.0000273815815785,
+ -0.0000062750421119,
+ 0.0000016064844184,
+ -0.0000004476392158,
+ 0.0000001334635874,
+ -0.0000000420735334,
+ 0.0000000139021990,
+ -0.0000000047831848,
+ 0.0000000017047897,
+ -0.0000000006268389,
+ 0.0000000002369824,
+ -0.0000000000918641,
+ 0.0000000000364278,
+ -0.0000000000147475,
+ 0.0000000000060851,
+ -0.0000000000025552,
+ 0.0000000000010906,
+ -0.0000000000004725,
+ 0.0000000000002076,
+ -0.0000000000000924,
+ 0.0000000000000417,
+ -0.0000000000000190,
+ 0.0000000000000087,
+ -0.0000000000000040,
+ 0.0000000000000019,
+ -0.0000000000000009,
+ 0.0000000000000004,
+ -0.0000000000000002,
+ 0.0000000000000001,
+ -0.0000000000000000};
+
+// series for am21 on the interval -1.25000d-01 to 0.
+// with weighted error 2.89e-17
+// log weighted error 16.54
+// significant figures required 14.15
+// decimal places required 17.34
+
+ private final static double am21cs[]={
+ 0.0065809191761485,
+ 0.0023675984685722,
+ 0.0001324741670371,
+ 0.0000157600904043,
+ 0.0000027529702663,
+ 0.0000006102679017,
+ 0.0000001595088468,
+ 0.0000000471033947,
+ 0.0000000152933871,
+ 0.0000000053590722,
+ 0.0000000020000910,
+ 0.0000000007872292,
+ 0.0000000003243103,
+ 0.0000000001390106,
+ 0.0000000000617011,
+ 0.0000000000282491,
+ 0.0000000000132979,
+ 0.0000000000064188,
+ 0.0000000000031697,
+ 0.0000000000015981,
+ 0.0000000000008213,
+ 0.0000000000004296,
+ 0.0000000000002284,
+ 0.0000000000001232,
+ 0.0000000000000675,
+ 0.0000000000000374,
+ 0.0000000000000210,
+ 0.0000000000000119,
+ 0.0000000000000068,
+ 0.0000000000000039,
+ 0.0000000000000023,
+ 0.0000000000000013,
+ 0.0000000000000008,
+ 0.0000000000000005,
+ 0.0000000000000003,
+ 0.0000000000000001,
+ 0.0000000000000001,
+ 0.0000000000000000,
+ 0.0000000000000000,
+ 0.0000000000000000};
+
+// series for ath1 on the interval -1.25000d-01 to 0.
+// with weighted error 2.53e-17
+// log weighted error 16.60
+// significant figures required 15.15
+// decimal places required 17.38
+
+ private final static double ath1cs[]={
+ -0.07125837815669365,
+ -0.00590471979831451,
+ -0.00012114544069499,
+ -0.00000988608542270,
+ -0.00000138084097352,
+ -0.00000026142640172,
+ -0.00000006050432589,
+ -0.00000001618436223,
+ -0.00000000483464911,
+ -0.00000000157655272,
+ -0.00000000055231518,
+ -0.00000000020545441,
+ -0.00000000008043412,
+ -0.00000000003291252,
+ -0.00000000001399875,
+ -0.00000000000616151,
+ -0.00000000000279614,
+ -0.00000000000130428,
+ -0.00000000000062373,
+ -0.00000000000030512,
+ -0.00000000000015239,
+ -0.00000000000007758,
+ -0.00000000000004020,
+ -0.00000000000002117,
+ -0.00000000000001132,
+ -0.00000000000000614,
+ -0.00000000000000337,
+ -0.00000000000000188,
+ -0.00000000000000105,
+ -0.00000000000000060,
+ -0.00000000000000034,
+ -0.00000000000000020,
+ -0.00000000000000011,
+ -0.00000000000000007,
+ -0.00000000000000004,
+ -0.00000000000000002};
+
+// series for am22 on the interval -1.00000d+00 to -1.25000d-01
+// with weighted error 2.99e-17
+// log weighted error 16.52
+// significant figures required 14.57
+// decimal places required 17.28
+
+ private final static double am22cs[]={
+ -0.01562844480625341,
+ 0.00778336445239681,
+ 0.00086705777047718,
+ 0.00015696627315611,
+ 0.00003563962571432,
+ 0.00000924598335425,
+ 0.00000262110161850,
+ 0.00000079188221651,
+ 0.00000025104152792,
+ 0.00000008265223206,
+ 0.00000002805711662,
+ 0.00000000976821090,
+ 0.00000000347407923,
+ 0.00000000125828132,
+ 0.00000000046298826,
+ 0.00000000017272825,
+ 0.00000000006523192,
+ 0.00000000002490471,
+ 0.00000000000960156,
+ 0.00000000000373448,
+ 0.00000000000146417,
+ 0.00000000000057826,
+ 0.00000000000022991,
+ 0.00000000000009197,
+ 0.00000000000003700,
+ 0.00000000000001496,
+ 0.00000000000000608,
+ 0.00000000000000248,
+ 0.00000000000000101,
+ 0.00000000000000041,
+ 0.00000000000000017,
+ 0.00000000000000007,
+ 0.00000000000000002};
+
+// series for ath2 on the interval -1.00000d+00 to -1.25000d-01
+// with weighted error 2.57e-17
+// log weighted error 16.59
+// significant figures required 15.07
+// decimal places required 17.34
+
+ private final static double ath2cs[]={
+ 0.00440527345871877,
+ -0.03042919452318455,
+ -0.00138565328377179,
+ -0.00018044439089549,
+ -0.00003380847108327,
+ -0.00000767818353522,
+ -0.00000196783944371,
+ -0.00000054837271158,
+ -0.00000016254615505,
+ -0.00000005053049981,
+ -0.00000001631580701,
+ -0.00000000543420411,
+ -0.00000000185739855,
+ -0.00000000064895120,
+ -0.00000000023105948,
+ -0.00000000008363282,
+ -0.00000000003071196,
+ -0.00000000001142367,
+ -0.00000000000429811,
+ -0.00000000000163389,
+ -0.00000000000062693,
+ -0.00000000000024260,
+ -0.00000000000009461,
+ -0.00000000000003716,
+ -0.00000000000001469,
+ -0.00000000000000584,
+ -0.00000000000000233,
+ -0.00000000000000093,
+ -0.00000000000000037,
+ -0.00000000000000015,
+ -0.00000000000000006,
+ -0.00000000000000002};
+
+// series for bi0 on the interval 0. to 9.00000d+00
+// with weighted error 2.46e-18
+// log weighted error 17.61
+// significant figures required 17.90
+// decimal places required 18.15
+
+ private final static double bi0cs[]={
+ -0.07660547252839144951,
+ 1.927337953993808270,
+ 0.2282644586920301339,
+ 0.01304891466707290428,
+ 0.00043442709008164874,
+ 0.00000942265768600193,
+ 0.00000014340062895106,
+ 0.00000000161384906966,
+ 0.00000000001396650044,
+ 0.00000000000009579451,
+ 0.00000000000000053339,
+ 0.00000000000000000245};
+
+// series for bj0 on the interval 0. to 1.60000d+01
+// with weighted error 7.47e-18
+// log weighted error 17.13
+// significant figures required 16.98
+// decimal places required 17.68
+
+ private final static double bj0cs[]={
+ 0.100254161968939137,
+ -0.665223007764405132,
+ 0.248983703498281314,
+ -0.0332527231700357697,
+ 0.0023114179304694015,
+ -0.0000991127741995080,
+ 0.0000028916708643998,
+ -0.0000000612108586630,
+ 0.0000000009838650793,
+ -0.0000000000124235515,
+ 0.0000000000001265433,
+ -0.0000000000000010619,
+ 0.0000000000000000074};
+
+// series for bm0 on the interval 0. to 6.25000d-02
+// with weighted error 4.98e-17
+// log weighted error 16.30
+// significant figures required 14.97
+// decimal places required 16.96
+
+ private final static double bm0cs[]={
+ 0.09284961637381644,
+ -0.00142987707403484,
+ 0.00002830579271257,
+ -0.00000143300611424,
+ 0.00000012028628046,
+ -0.00000001397113013,
+ 0.00000000204076188,
+ -0.00000000035399669,
+ 0.00000000007024759,
+ -0.00000000001554107,
+ 0.00000000000376226,
+ -0.00000000000098282,
+ 0.00000000000027408,
+ -0.00000000000008091,
+ 0.00000000000002511,
+ -0.00000000000000814,
+ 0.00000000000000275,
+ -0.00000000000000096,
+ 0.00000000000000034,
+ -0.00000000000000012,
+ 0.00000000000000004};
+
+// series for bth0 on the interval 0. to 6.25000d-02
+// with weighted error 3.67e-17
+// log weighted error 16.44
+// significant figures required 15.53
+// decimal places required 17.13
+
+ private final static double bth0cs[]={
+ -0.24639163774300119,
+ 0.001737098307508963,
+ -0.000062183633402968,
+ 0.000004368050165742,
+ -0.000000456093019869,
+ 0.000000062197400101,
+ -0.000000010300442889,
+ 0.000000001979526776,
+ -0.000000000428198396,
+ 0.000000000102035840,
+ -0.000000000026363898,
+ 0.000000000007297935,
+ -0.000000000002144188,
+ 0.000000000000663693,
+ -0.000000000000215126,
+ 0.000000000000072659,
+ -0.000000000000025465,
+ 0.000000000000009229,
+ -0.000000000000003448,
+ 0.000000000000001325,
+ -0.000000000000000522,
+ 0.000000000000000210,
+ -0.000000000000000087,
+ 0.000000000000000036};
+
+// series for by0 on the interval 0. to 1.60000d+01
+// with weighted error 1.20e-17
+// log weighted error 16.92
+// significant figures required 16.15
+// decimal places required 17.48
+
+ private final static double by0cs[]={
+ -0.011277839392865573,
+ -0.12834523756042035,
+ -0.10437884799794249,
+ 0.023662749183969695,
+ -0.002090391647700486,
+ 0.000103975453939057,
+ -0.000003369747162423,
+ 0.000000077293842676,
+ -0.000000001324976772,
+ 0.000000000017648232,
+ -0.000000000000188105,
+ 0.000000000000001641,
+ -0.000000000000000011};
+
+// series for bi1 on the interval 0. to 9.00000d+00
+// with weighted error 2.40e-17
+// log weighted error 16.62
+// significant figures required 16.23
+// decimal places required 17.14
+
+ private final static double bi1cs[]={
+ -0.001971713261099859,
+ 0.40734887667546481,
+ 0.034838994299959456,
+ 0.001545394556300123,
+ 0.000041888521098377,
+ 0.000000764902676483,
+ 0.000000010042493924,
+ 0.000000000099322077,
+ 0.000000000000766380,
+ 0.000000000000004741,
+ 0.000000000000000024};
+
+// series for bj1 on the interval 0. to 1.60000d+01
+// with weighted error 4.48e-17
+// log weighted error 16.35
+// significant figures required 15.77
+// decimal places required 16.89
+
+ private final static double bj1cs[]={
+ -0.11726141513332787,
+ -0.25361521830790640,
+ 0.050127080984469569,
+ -0.004631514809625081,
+ 0.000247996229415914,
+ -0.000008678948686278,
+ 0.000000214293917143,
+ -0.000000003936093079,
+ 0.000000000055911823,
+ -0.000000000000632761,
+ 0.000000000000005840,
+ -0.000000000000000044};
+
+// series for bm1 on the interval 0. to 6.25000d-02
+// with weighted error 5.61e-17
+// log weighted error 16.25
+// significant figures required 14.97
+// decimal places required 16.91
+
+ private final static double bm1cs[]={
+ 0.1047362510931285,
+ 0.00442443893702345,
+ -0.00005661639504035,
+ 0.00000231349417339,
+ -0.00000017377182007,
+ 0.00000001893209930,
+ -0.00000000265416023,
+ 0.00000000044740209,
+ -0.00000000008691795,
+ 0.00000000001891492,
+ -0.00000000000451884,
+ 0.00000000000116765,
+ -0.00000000000032265,
+ 0.00000000000009450,
+ -0.00000000000002913,
+ 0.00000000000000939,
+ -0.00000000000000315,
+ 0.00000000000000109,
+ -0.00000000000000039,
+ 0.00000000000000014,
+ -0.00000000000000005};
+
+// series for bth1 on the interval 0. to 6.25000d-02
+// with weighted error 4.10e-17
+// log weighted error 16.39
+// significant figures required 15.96
+// decimal places required 17.08
+
+ private final static double bth1cs[]={
+ 0.74060141026313850,
+ -0.004571755659637690,
+ 0.000119818510964326,
+ -0.000006964561891648,
+ 0.000000655495621447,
+ -0.000000084066228945,
+ 0.000000013376886564,
+ -0.000000002499565654,
+ 0.000000000529495100,
+ -0.000000000124135944,
+ 0.000000000031656485,
+ -0.000000000008668640,
+ 0.000000000002523758,
+ -0.000000000000775085,
+ 0.000000000000249527,
+ -0.000000000000083773,
+ 0.000000000000029205,
+ -0.000000000000010534,
+ 0.000000000000003919,
+ -0.000000000000001500,
+ 0.000000000000000589,
+ -0.000000000000000237,
+ 0.000000000000000097,
+ -0.000000000000000040};
+
+// series for by1 on the interval 0. to 1.60000d+01
+// with weighted error 1.87e-18
+// log weighted error 17.73
+// significant figures required 17.83
+// decimal places required 18.30
+
+ private final static double by1cs[]={
+ 0.03208047100611908629,
+ 1.262707897433500450,
+ 0.00649996189992317500,
+ -0.08936164528860504117,
+ 0.01325088122175709545,
+ -0.00089790591196483523,
+ 0.00003647361487958306,
+ -0.00000100137438166600,
+ 0.00000001994539657390,
+ -0.00000000030230656018,
+ 0.00000000000360987815,
+ -0.00000000000003487488,
+ 0.00000000000000027838,
+ -0.00000000000000000186};
+
+
+
+ /**
+ * Evaluates a Chebyshev series.
+ * @param x value at which to evaluate series
+ * @param series the coefficients of the series
+ */
+ public static double chebyshev(double x, double series[]) {
+ double twox,b0=0.0,b1=0.0,b2=0.0;
+ twox=2*x;
+ for(int i=series.length-1;i>-1;i--) {
+ b2=b1;
+ b1=b0;
+ b0=twox*b1-b2+series[i];
+ }
+ return 0.5*(b0-b2);
+ }
+ /**
+ * Airy function.
+ * Based on the NETLIB Fortran function ai written by W. Fullerton.
+ */
+ public static double airy(double x) {
+ if(x<-1.0) {
+ return airyModPhase(x);
+ } else if(x>1.0)
+ return expAiry(x)*Math.exp(-2.0*x*Math.sqrt(x)/3.0);
+ else {
+ final double z=x*x*x;
+ return 0.375+(chebyshev(z,aifcs)-x*(0.25+chebyshev(z,aigcs)));
+ }
+ }
+ /**
+ * Airy modulus and phase.
+ * Based on the NETLIB Fortran subroutine r9aimp written by W. Fullerton.
+ * @return the real part, i.e. modulus*cos(phase).
+ */
+ private static double airyModPhase(double x) {
+ double modulus, phase;
+ if(x < -2.0) {
+ double z = 16.0/(x*x*x)+1.0;
+ modulus = 0.3125+chebyshev(z, am21cs);
+ phase = -0.625+chebyshev(z, ath1cs);
+ } else {
+ double z = (16.0/(x*x*x)+9.0)/7.0;
+ modulus = 0.3125+chebyshev(z, am22cs);
+ phase = -0.625+chebyshev(z, ath2cs);
+ }
+ final double sqrtx = Math.sqrt(-x);
+ modulus = Math.sqrt(modulus/sqrtx);
+ phase = Math.PI/4.0-x*sqrtx*phase;
+ return modulus*Math.cos(phase);
+ }
+ /**
+ * Exponential scaled Airy function.
+ * Based on the NETLIB Fortran function aie written by W. Fullerton.
+ */
+ private static double expAiry(double x) {
+ if(x<-1.0) {
+ return airyModPhase(x);
+ } else if(x<=1.0) {
+ final double z=x*x*x;
+ return 0.375+(chebyshev(z,aifcs)-x*(0.25+chebyshev(z,aigcs)))*Math.exp(2.0*x*Math.sqrt(x)/3.0);
+ } else {
+ final double sqrtx=Math.sqrt(x);
+ final double z=2.0/(x*sqrtx)-1.0;
+ return (0.28125+chebyshev(z,aipcs))/Math.sqrt(sqrtx);
+ }
+ }
+ /**
+ * Bessel function of first kind, order zero.
+ * Based on the NETLIB Fortran function besj0 written by W. Fullerton.
+ */
+ public static double besselFirstZero(double x) {
+ double y=Math.abs(x);
+ if(y>4.0) {
+ final double z=32/(y*y)-1;
+ final double amplitude=(0.75+chebyshev(z,bm0cs))/Math.sqrt(y);
+ final double theta=y-Math.PI/4.0+chebyshev(z,bth0cs)/y;
+ return amplitude*Math.cos(theta);
+ } else if(y==0.0)
+ return 1.0;
+ else
+ return chebyshev(0.125*y*y-1,bj0cs);
+ }
+ /**
+ * Modified Bessel function of first kind, order zero.
+ * Based on the NETLIB Fortran function besi0 written by W. Fullerton.
+ */
+ public static double modBesselFirstZero(double x) {
+ double y=Math.abs(x);
+ if(y>3.0)
+ return Math.exp(y)*expModBesselFirstZero(x);
+ else
+ return 2.75+chebyshev(y*y/4.5-1.0, bi0cs);
+ }
+ /**
+ * Exponential scaled modified Bessel function of first kind, order zero.
+ * Based on the NETLIB Fortran function besi0e written by W. Fullerton.
+ */
+ private static double expModBesselFirstZero(double x) {
+ final double y=Math.abs(x);
+ if(y>3.0) {
+ if(y>8.0)
+ return (0.375+chebyshev(16.0/y-1.0, ai02cs))/Math.sqrt(y);
+ else
+ return (0.375+chebyshev((48.0/y-11.0)/5.0, ai0cs))/Math.sqrt(y);
+ } else
+ return Math.exp(-y)*(2.75+chebyshev(y*y/4.5-1.0, bi0cs));
+ }
+ /**
+ * Bessel function of first kind, order one.
+ * Based on the NETLIB Fortran function besj1 written by W. Fullerton.
+ */
+ public static double besselFirstOne(double x) {
+ double y=Math.abs(x);
+ if(y>4.0) {
+ final double z=32.0/(y*y)-1.0;
+ final double amplitude=(0.75+chebyshev(z, bm1cs))/Math.sqrt(y);
+ final double theta=y-3.0*Math.PI/4.0+chebyshev(z, bth1cs)/y;
+ return Math.abs(amplitude)*x*Math.cos(theta)/Math.abs(x);
+ } else if(y==0.0)
+ return 0.0;
+ else
+ return x*(0.25+chebyshev(0.125*y*y-1.0, bj1cs));
+ }
+ /**
+ * Modified Bessel function of first kind, order one.
+ * Based on the NETLIB Fortran function besi1 written by W. Fullerton.
+ */
+ public static double modBesselFirstOne(double x) {
+ final double y=Math.abs(x);
+ if(y>3.0)
+ return Math.exp(y)*expModBesselFirstOne(x);
+ else if(y==0.0)
+ return 0.0;
+ else
+ return x*(0.875+chebyshev(y*y/4.5-1.0, bi1cs));
+ }
+ /**
+ * Exponential scaled modified Bessel function of first kind, order one.
+ * Based on the NETLIB Fortran function besi1e written by W. Fullerton.
+ */
+ private static double expModBesselFirstOne(double x) {
+ final double y=Math.abs(x);
+ if(y>3.0) {
+ if(y>8.0)
+ return x/y*(0.375+chebyshev(16.0/y-1.0, ai12cs))/Math.sqrt(y);
+ else
+ return x/y*(0.375+chebyshev((48.0/y-11.0)/5.0, ai1cs))/Math.sqrt(y);
+ } else if(y==0.0)
+ return 0.0;
+ else
+ return Math.exp(-y)*x*(0.875+chebyshev(y*y/4.5-1.0, bi1cs));
+ }
+ /**
+ * Bessel function of second kind, order zero.
+ * Based on the NETLIB Fortran function besy0 written by W. Fullerton.
+ */
+ public static double besselSecondZero(double x) {
+ if(x>4.0) {
+ final double z=32.0/(x*x)-1.0;
+ final double amplitude=(0.75+chebyshev(z, bm0cs))/Math.sqrt(x);
+ final double theta=x-Math.PI/4+chebyshev(z, bth0cs)/x;
+ return amplitude*Math.sin(theta);
+ } else
+ return (Math.log(0.5)+Math.log(x))*besselFirstZero(x)+0.375+chebyshev(0.125*x*x-1.0,by0cs)*2.0/Math.PI;
+ }
+ /**
+ * Bessel function of second kind, order one.
+ * Based on the NETLIB Fortran function besy1 written by W. Fullerton.
+ */
+ public static double besselSecondOne(double x) {
+ if(x>4.0) {
+ final double z=32.0/(x*x)-1.0;
+ final double amplitude=(0.75+chebyshev(z, bm1cs))/Math.sqrt(x);
+ final double theta=x-3.0*Math.PI/4.0+chebyshev(z, bth1cs)/x;
+ return amplitude*Math.sin(theta);
+ } else
+ return 2.0*Math.log(0.5*x)*besselFirstOne(x)/Math.PI+(0.5+chebyshev(0.125*x*x-1.0, by1cs))/x;
+ }
+
+ private final static double LOGSQRT2PI=Math.log(SQRT2PI);
+
+// Gamma function related constants
+ private final static double g_p[] = { -1.71618513886549492533811,
+ 24.7656508055759199108314, -379.804256470945635097577,
+ 629.331155312818442661052, 866.966202790413211295064,
+ -31451.2729688483675254357, -36144.4134186911729807069,
+ 66456.1438202405440627855 };
+ private final static double g_q[] = { -30.8402300119738975254353,
+ 315.350626979604161529144, -1015.15636749021914166146,
+ -3107.77167157231109440444, 22538.1184209801510330112,
+ 4755.84627752788110767815, -134659.959864969306392456,
+ -115132.259675553483497211 };
+ private final static double g_c[] = { -0.001910444077728,8.4171387781295e-4,
+ -5.952379913043012e-4, 7.93650793500350248e-4,
+ -0.002777777777777681622553, 0.08333333333333333331554247,
+ 0.0057083835261 };
+ /**
+ * The largest argument for which gamma(x) is representable in the machine.
+ */
+ public final static double GAMMA_X_MAX_VALUE = 171.624;
+
+ /**
+ * Gamma function.
+ * Based on public domain NETLIB (Fortran) code by W. J. Cody and L. Stoltz
+ * Applied Mathematics Division
+ * Argonne National Laboratory
+ * Argonne, IL 60439
+ *
+ * References:
+ *
+ *
"An Overview of Software Development for Special Functions", W. J. Cody, Lecture Notes in Mathematics, 506, Numerical Analysis Dundee, 1975, G. A. Watson (ed.), Springer Verlag, Berlin, 1976.
+ *
Computer Approximations, Hart, Et. Al., Wiley and sons, New York, 1968.
+ *
+ * From the original documentation:
+ *
+ * This routine calculates the GAMMA function for a real argument X.
+ * Computation is based on an algorithm outlined in reference 1.
+ * The program uses rational functions that approximate the GAMMA
+ * function to at least 20 significant decimal digits. Coefficients
+ * for the approximation over the interval (1,2) are unpublished.
+ * Those for the approximation for X .GE. 12 are from reference 2.
+ * The accuracy achieved depends on the arithmetic system, the
+ * compiler, the intrinsic functions, and proper selection of the
+ * machine-dependent constants.
+ *
+ * Error returns:
+ * The program returns the value XINF for singularities or when overflow would occur.
+ * The computation is believed to be free of underflow and overflow.
+ *
+ * @return Double.MAX_VALUE if overflow would occur, i.e. if abs(x) > 171.624
+ * @jsci.planetmath GammaFunction
+ * @author Jaco van Kooten
+ */
+ public static double gamma(double x) {
+ double fact=1.0, xden, xnum;
+ int i, n=0;
+ double y=x, z, y1;
+ boolean parity=false;
+ double res, sum, ysq;
+
+ if (y <= 0.0) {
+// ----------------------------------------------------------------------
+// Argument is negative
+// ----------------------------------------------------------------------
+ y = -(x);
+ y1 = (int)y;
+ res = y - y1;
+ if (res != 0.0) {
+ if (y1 != (((int)(y1*0.5)) * 2.0))
+ parity = true;
+ fact = -Math.PI/ Math.sin(Math.PI * res);
+ y++;
+ } else
+ return Double.MAX_VALUE;
+ }
+// ----------------------------------------------------------------------
+// Argument is positive
+// ----------------------------------------------------------------------
+ if (y < EPS) {
+// ----------------------------------------------------------------------
+// Argument .LT. EPS
+// ----------------------------------------------------------------------
+ if (y >= XMININ)
+ res = 1.0 / y;
+ else
+ return Double.MAX_VALUE;
+ } else if (y < 12.0) {
+ y1 = y;
+ if (y < 1.0) {
+// ----------------------------------------------------------------------
+// 0.0 .LT. argument .LT. 1.0
+// ----------------------------------------------------------------------
+ z = y;
+ y++;
+ } else {
+// ----------------------------------------------------------------------
+// 1.0 .LT. argument .LT. 12.0, reduce argument if necessary
+// ----------------------------------------------------------------------
+ n = (int)y - 1;
+ y -= (double) n;
+ z = y - 1.0;
+ }
+// ----------------------------------------------------------------------
+// Evaluate approximation for 1.0 .LT. argument .LT. 2.0
+// ----------------------------------------------------------------------
+ xnum = 0.0;
+ xden = 1.0;
+ for (i = 0; i < 8; ++i) {
+ xnum = (xnum + g_p[i]) * z;
+ xden = xden * z + g_q[i];
+ }
+ res = xnum / xden + 1.0;
+ if (y1 < y)
+// ----------------------------------------------------------------------
+// Adjust result for case 0.0 .LT. argument .LT. 1.0
+// ----------------------------------------------------------------------
+ res /= y1;
+ else if (y1 > y) {
+// ----------------------------------------------------------------------
+// Adjust result for case 2.0 .LT. argument .LT. 12.0
+// ----------------------------------------------------------------------
+ for (i = 0; i < n; ++i) {
+ res *= y;
+ y++;
+ }
+ }
+ } else {
+// ----------------------------------------------------------------------
+// Evaluate for argument .GE. 12.0
+// ----------------------------------------------------------------------
+ if (y <= GAMMA_X_MAX_VALUE) {
+ ysq = y * y;
+ sum = g_c[6];
+ for (i = 0; i < 6; ++i)
+ sum = sum / ysq + g_c[i];
+ sum = sum / y - y + LOGSQRT2PI;
+ sum += (y - 0.5) * Math.log(y);
+ res = Math.exp(sum);
+ } else
+ return Double.MAX_VALUE;
+ }
+// ----------------------------------------------------------------------
+// Final adjustments and return
+// ----------------------------------------------------------------------
+ if (parity)
+ res = -res;
+ if (fact != 1.0)
+ res = fact / res;
+ return res;
+ }
+
+ /**
+ * The largest argument for which logGamma(x) is representable in the machine.
+ */
+ public final static double LOG_GAMMA_X_MAX_VALUE = 2.55e305;
+
+// Log Gamma related constants
+ private final static double lg_d1 = -0.5772156649015328605195174;
+ private final static double lg_d2 = 0.4227843350984671393993777;
+ private final static double lg_d4 = 1.791759469228055000094023;
+ private final static double lg_p1[] = { 4.945235359296727046734888,
+ 201.8112620856775083915565, 2290.838373831346393026739,
+ 11319.67205903380828685045, 28557.24635671635335736389,
+ 38484.96228443793359990269, 26377.48787624195437963534,
+ 7225.813979700288197698961 };
+ private final static double lg_q1[] = { 67.48212550303777196073036,
+ 1113.332393857199323513008, 7738.757056935398733233834,
+ 27639.87074403340708898585, 54993.10206226157329794414,
+ 61611.22180066002127833352, 36351.27591501940507276287,
+ 8785.536302431013170870835 };
+ private final static double lg_p2[] = { 4.974607845568932035012064,
+ 542.4138599891070494101986, 15506.93864978364947665077,
+ 184793.2904445632425417223, 1088204.76946882876749847,
+ 3338152.967987029735917223, 5106661.678927352456275255,
+ 3074109.054850539556250927 };
+ private final static double lg_q2[] = { 183.0328399370592604055942,
+ 7765.049321445005871323047, 133190.3827966074194402448,
+ 1136705.821321969608938755, 5267964.117437946917577538,
+ 13467014.54311101692290052, 17827365.30353274213975932,
+ 9533095.591844353613395747 };
+ private final static double lg_p4[] = { 14745.02166059939948905062,
+ 2426813.369486704502836312, 121475557.4045093227939592,
+ 2663432449.630976949898078, 29403789566.34553899906876,
+ 170266573776.5398868392998, 492612579337.743088758812,
+ 560625185622.3951465078242 };
+ private final static double lg_q4[] = { 2690.530175870899333379843,
+ 639388.5654300092398984238, 41355999.30241388052042842,
+ 1120872109.61614794137657, 14886137286.78813811542398,
+ 101680358627.2438228077304, 341747634550.7377132798597,
+ 446315818741.9713286462081 };
+ private final static double lg_c[] = { -0.001910444077728,8.4171387781295e-4,
+ -5.952379913043012e-4, 7.93650793500350248e-4,
+ -0.002777777777777681622553, 0.08333333333333333331554247,
+ 0.0057083835261 };
+// Rough estimate of the fourth root of logGamma_xBig
+ private final static double lg_frtbig = 2.25e76;
+ private final static double pnt68 = 0.6796875;
+
+// Function cache for logGamma
+ private static final ThreadLocal logGammaCache_res=new ThreadLocal() {
+ protected Object initialValue() {
+ return new Double(0.0);
+ }
+
+ };
+ private static final ThreadLocal logGammaCache_x=new ThreadLocal() {
+ protected Object initialValue() {
+ return new Double(0.0);
+ }
+ };
+
+ /**
+ * The natural logarithm of the gamma function.
+ * Based on public domain NETLIB (Fortran) code by W. J. Cody and L. Stoltz
+ * Applied Mathematics Division
+ * Argonne National Laboratory
+ * Argonne, IL 60439
+ *
+ * References:
+ *
+ *
W. J. Cody and K. E. Hillstrom, 'Chebyshev Approximations for the Natural Logarithm of the Gamma Function,' Math. Comp. 21, 1967, pp. 198-203.
+ *
K. E. Hillstrom, ANL/AMD Program ANLC366S, DGAMMA/DLGAMA, May, 1969.
+ *
Hart, Et. Al., Computer Approximations, Wiley and sons, New York, 1968.
+ *
+ * From the original documentation:
+ *
+ * This routine calculates the LOG(GAMMA) function for a positive real argument X.
+ * Computation is based on an algorithm outlined in references 1 and 2.
+ * The program uses rational functions that theoretically approximate LOG(GAMMA)
+ * to at least 18 significant decimal digits. The approximation for X > 12 is from reference 3,
+ * while approximations for X < 12.0 are similar to those in reference 1, but are unpublished.
+ * The accuracy achieved depends on the arithmetic system, the compiler, the intrinsic functions,
+ * and proper selection of the machine-dependent constants.
+ *
+ * Error returns:
+ * The program returns the value XINF for X .LE. 0.0 or when overflow would occur.
+ * The computation is believed to be free of underflow and overflow.
+ *
+ * @return Double.MAX_VALUE for x < 0.0 or when overflow would occur, i.e. x > 2.55E305
+ * @author Jaco van Kooten
+ */
+ public static double logGamma(double x) {
+ double xden, corr, xnum;
+ int i;
+ double y, xm1, xm2, xm4, res, ysq;
+
+ if (x == ((Double) logGammaCache_x.get()).doubleValue())
+ return ((Double) logGammaCache_res.get()).doubleValue();
+
+ y = x;
+ if (y > 0.0 && y <= LOG_GAMMA_X_MAX_VALUE) {
+ if (y <= EPS) {
+ res = -Math.log(y);
+ } else if (y <= 1.5) {
+// ----------------------------------------------------------------------
+// EPS .LT. X .LE. 1.5
+// ----------------------------------------------------------------------
+ if (y < pnt68) {
+ corr = -Math.log(y);
+ xm1 = y;
+ } else {
+ corr = 0.0;
+ xm1 = y - 1.0;
+ }
+ if (y <= 0.5 || y >= pnt68) {
+ xden = 1.0;
+ xnum = 0.0;
+ for (i = 0; i < 8; i++) {
+ xnum = xnum * xm1 + lg_p1[i];
+ xden = xden * xm1 + lg_q1[i];
+ }
+ res = corr + xm1 * (lg_d1 + xm1 * (xnum / xden));
+ } else {
+ xm2 = y - 1.0;
+ xden = 1.0;
+ xnum = 0.0;
+ for (i = 0; i < 8; i++) {
+ xnum = xnum * xm2 + lg_p2[i];
+ xden = xden * xm2 + lg_q2[i];
+ }
+ res = corr + xm2 * (lg_d2 + xm2 * (xnum / xden));
+ }
+ } else if (y <= 4.0) {
+// ----------------------------------------------------------------------
+// 1.5 .LT. X .LE. 4.0
+// ----------------------------------------------------------------------
+ xm2 = y - 2.0;
+ xden = 1.0;
+ xnum = 0.0;
+ for (i = 0; i < 8; i++) {
+ xnum = xnum * xm2 + lg_p2[i];
+ xden = xden * xm2 + lg_q2[i];
+ }
+ res = xm2 * (lg_d2 + xm2 * (xnum / xden));
+ } else if (y <= 12.0) {
+// ----------------------------------------------------------------------
+// 4.0 .LT. X .LE. 12.0
+// ----------------------------------------------------------------------
+ xm4 = y - 4.0;
+ xden = -1.0;
+ xnum = 0.0;
+ for (i = 0; i < 8; i++) {
+ xnum = xnum * xm4 + lg_p4[i];
+ xden = xden * xm4 + lg_q4[i];
+ }
+ res = lg_d4 + xm4 * (xnum / xden);
+ } else {
+// ----------------------------------------------------------------------
+// Evaluate for argument .GE. 12.0
+// ----------------------------------------------------------------------
+ res = 0.0;
+ if (y <= lg_frtbig) {
+ res = lg_c[6];
+ ysq = y * y;
+ for (i = 0; i < 6; i++)
+ res = res / ysq + lg_c[i];
+ }
+ res /= y;
+ corr = Math.log(y);
+ res = res + LOGSQRT2PI - 0.5 * corr;
+ res += y * (corr - 1.0);
+ }
+ } else {
+// ----------------------------------------------------------------------
+// Return for bad arguments
+// ----------------------------------------------------------------------
+ res = Double.MAX_VALUE;
+ }
+// ----------------------------------------------------------------------
+// Final adjustments and return
+// ----------------------------------------------------------------------
+ logGammaCache_x.set(new Double(x));
+ logGammaCache_res.set(new Double(res));
+ return res;
+ }
+
+ private final static int MAX_ITERATIONS = 1000000000;
+ // lower value = higher precision
+ private final static double PRECISION = 4.0*EPS;
+
+ /**
+ * Incomplete gamma function.
+ * The computation is based on approximations presented in Numerical Recipes, Chapter 6.2 (W.H. Press et al, 1992).
+ * @param a require a>=0
+ * @param x require x>=0
+ * @return 0 if x<0, a<=0 or a>2.55E305 to avoid errors and over/underflow
+ * @author Jaco van Kooten
+ */
+ public static double incompleteGamma(double a, double x) {
+ if (x <= 0.0 || a <= 0.0 || a > LOG_GAMMA_X_MAX_VALUE)
+ return 0.0;
+ if (x < (a+1.0))
+ return gammaSeriesExpansion(a,x);
+ else
+ return 1.0-gammaFraction(a,x);
+ }
+ /**
+ * @author Jaco van Kooten
+ */
+ private static double gammaSeriesExpansion(double a, double x) {
+ double ap = a;
+ double del = 1.0/a;
+ double sum = del;
+ for (int n=1; n < MAX_ITERATIONS; n++) {
+ ++ap;
+ del *= x/ap;
+ sum += del;
+ if (del < sum*PRECISION)
+ return sum*Math.exp(-x + a*Math.log(x) - logGamma(a));
+ }
+ throw new RuntimeException("Maximum iterations exceeded: please file a bug report.");
+ }
+ /**
+ * @author Jaco van Kooten
+ */
+ private static double gammaFraction(double a, double x) {
+ double b=x+1.0-a;
+ double c=1.0/XMININ;
+ double d=1.0/b;
+ double h=d;
+ double del=0.0;
+ double an;
+ for (int i=1; iPRECISION; i++) {
+ an = -i*(i-a);
+ b += 2.0;
+ d=an*d+b;
+ c=b+an/c;
+ if (Math.abs(c) < XMININ)
+ c=XMININ;
+ if (Math.abs(d) < XMININ)
+ c=XMININ;
+ d=1.0/d;
+ del=d*c;
+ h *= del;
+ }
+ return Math.exp(-x + a*Math.log(x) - logGamma(a))*h;
+ }
+ /**
+ * Beta function.
+ * @param p require p>0
+ * @param q require q>0
+ * @return 0 if p<=0, q<=0 or p+q>2.55E305 to avoid errors and over/underflow
+ * @author Jaco van Kooten
+ */
+ public static double beta(double p, double q) {
+ if (p <= 0.0 || q <= 0.0 || (p+q) > LOG_GAMMA_X_MAX_VALUE)
+ return 0.0;
+ else
+ return Math.exp(logBeta(p,q));
+ }
+
+// Function cache for logBeta
+ private static final ThreadLocal logBetaCache_res=new ThreadLocal() {
+ protected Object initialValue() {
+ return new Double(0.0);
+ }
+ };
+ private static final ThreadLocal logBetaCache_p=new ThreadLocal() {
+ protected Object initialValue() {
+ return new Double(0.0);
+ }
+ };
+ private static final ThreadLocal logBetaCache_q=new ThreadLocal() {
+ protected Object initialValue() {
+ return new Double(0.0);
+ }
+ };
+
+ /**
+ * The natural logarithm of the beta function.
+ * @param p require p>0
+ * @param q require q>0
+ * @return 0 if p<=0, q<=0 or p+q>2.55E305 to avoid errors and over/underflow
+ * @author Jaco van Kooten
+ */
+ public static double logBeta(double p, double q) {
+ if (p != ((Double) logBetaCache_p.get()).doubleValue()
+ || q != ((Double) logBetaCache_q.get()).doubleValue()) {
+ logBetaCache_p.set(new Double(p));
+ logBetaCache_q.set(new Double(q));
+ double res;
+ if (p <= 0.0 || q <= 0.0 || (p+q) > LOG_GAMMA_X_MAX_VALUE)
+ res = 0.0;
+ else
+ res = logGamma(p)+logGamma(q)-logGamma(p+q);
+ logBetaCache_res.set(new Double(res));
+ return res;
+ } else {
+ return ((Double) logBetaCache_res.get()).doubleValue();
+ }
+ }
+ /**
+ * Incomplete beta function.
+ * The computation is based on formulas from Numerical Recipes, Chapter 6.4 (W.H. Press et al, 1992).
+ * @param x require 0<=x<=1
+ * @param p require p>0
+ * @param q require q>0
+ * @return 0 if x<0, p<=0, q<=0 or p+q>2.55E305 and 1 if x>1 to avoid errors and over/underflow
+ * @author Jaco van Kooten
+ */
+ public static double incompleteBeta(double x, double p, double q) {
+ if (x <= 0.0)
+ return 0.0;
+ else if (x >= 1.0)
+ return 1.0;
+ else if (p <= 0.0 || q <= 0.0 || (p+q) > LOG_GAMMA_X_MAX_VALUE)
+ return 0.0;
+ else {
+ final double beta_gam=Math.exp(-logBeta(p,q) + p*Math.log(x) + q*Math.log(1.0-x));
+ if (x < (p+1.0)/(p+q+2.0))
+ return beta_gam*betaFraction(x,p,q)/p;
+ else
+ return 1.0-(beta_gam*betaFraction(1.0-x,q,p)/q);
+ }
+ }
+ /**
+ * Evaluates of continued fraction part of incomplete beta function.
+ * Based on an idea from Numerical Recipes (W.H. Press et al, 1992).
+ * @author Jaco van Kooten
+ */
+ private static double betaFraction(double x, double p, double q) {
+ int m, m2;
+ double sum_pq, p_plus, p_minus, c =1.0 , d, delta, h, frac;
+ sum_pq = p + q;
+ p_plus = p + 1.0;
+ p_minus = p - 1.0;
+ h=1.0-sum_pq*x/p_plus;
+ if (Math.abs(h) < XMININ)
+ h=XMININ;
+ h=1.0/h;
+ frac = h;
+ m=1;
+ delta = 0.0;
+ while (m <= MAX_ITERATIONS && Math.abs(delta-1.0) > PRECISION ) {
+ m2=2*m;
+ // even index for d
+ d=m*(q-m)*x/((p_minus+m2)*(p+m2));
+ h=1.0+d*h;
+ if (Math.abs(h) < XMININ)
+ h=XMININ;
+ h=1.0/h;
+ c=1.0+d/c;
+ if (Math.abs(c) < XMININ)
+ c=XMININ;
+ frac *= h*c;
+ // odd index for d
+ d = -(p+m)*(sum_pq+m)*x/((p+m2)*(p_plus+m2));
+ h=1.0+d*h;
+ if (Math.abs(h) < XMININ)
+ h=XMININ;
+ h=1.0/h;
+ c=1.0+d/c;
+ if (Math.abs(c) < XMININ)
+ c=XMININ;
+ delta=h*c;
+ frac *= delta;
+ m++;
+ }
+ return frac;
+ }
+
+// ====================================================
+// Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+//
+// Developed at SunSoft, a Sun Microsystems, Inc. business.
+// Permission to use, copy, modify, and distribute this
+// software is freely granted, provided that this notice
+// is preserved.
+// ====================================================
+//
+// x
+// 2 |\
+// erf(x) = --------- | exp(-t*t)dt
+// sqrt(pi) \|
+// 0
+//
+// erfc(x) = 1-erf(x)
+// Note that
+// erf(-x) = -erf(x)
+// erfc(-x) = 2 - erfc(x)
+//
+// Method:
+// 1. For |x| in [0, 0.84375]
+// erf(x) = x + x*R(x^2)
+// erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
+// = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
+// where R = P/Q where P is an odd poly of degree 8 and
+// Q is an odd poly of degree 10.
+// -57.90
+// | R - (erf(x)-x)/x | <= 2
+//
+//
+// Remark. The formula is derived by noting
+// erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
+// and that
+// 2/sqrt(pi) = 1.128379167095512573896158903121545171688
+// is close to one. The interval is chosen because the fix
+// point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
+// near 0.6174), and by some experiment, 0.84375 is chosen to
+// guarantee the error is less than one ulp for erf.
+//
+// 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
+// c = 0.84506291151 rounded to single (24 bits)
+// erf(x) = sign(x) * (c + P1(s)/Q1(s))
+// erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
+// 1+(c+P1(s)/Q1(s)) if x < 0
+// |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
+// Remark: here we use the taylor series expansion at x=1.
+// erf(1+s) = erf(1) + s*Poly(s)
+// = 0.845.. + P1(s)/Q1(s)
+// That is, we use rational approximation to approximate
+// erf(1+s) - (c = (single)0.84506291151)
+// Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
+// where
+// P1(s) = degree 6 poly in s
+// Q1(s) = degree 6 poly in s
+//
+// 3. For x in [1.25,1/0.35(~2.857143)],
+// erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
+// erf(x) = 1 - erfc(x)
+// where
+// R1(z) = degree 7 poly in z, (z=1/x^2)
+// S1(z) = degree 8 poly in z
+//
+// 4. For x in [1/0.35,28]
+// erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
+// = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6 x >= 28
+// erf(x) = sign(x) *(1 - tiny) (raise inexact)
+// erfc(x) = tiny*tiny (raise underflow) if x > 0
+// = 2 - tiny if x<0
+//
+// 7. Special case:
+// erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
+// erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
+// erfc/erf(NaN) is NaN
+//
+
+// Coefficients for approximation to erf on [0,0.84375]
+ private final static double e_efx=1.28379167095512586316e-01;
+// private final static double efx8=1.02703333676410069053e00;
+ private final static double ePp[]={
+ 1.28379167095512558561e-01,
+ -3.25042107247001499370e-01,
+ -2.84817495755985104766e-02,
+ -5.77027029648944159157e-03,
+ -2.37630166566501626084e-05};
+ private final static double eQq[]={
+ 3.97917223959155352819e-01,
+ 6.50222499887672944485e-02,
+ 5.08130628187576562776e-03,
+ 1.32494738004321644526e-04,
+ -3.96022827877536812320e-06};
+// Coefficients for approximation to erf in [0.84375,1.25]
+ private final static double ePa[]={
+ -2.36211856075265944077e-03,
+ 4.14856118683748331666e-01,
+ -3.72207876035701323847e-01,
+ 3.18346619901161753674e-01,
+ -1.10894694282396677476e-01,
+ 3.54783043256182359371e-02,
+ -2.16637559486879084300e-03};
+ private final static double eQa[]={
+ 1.06420880400844228286e-01,
+ 5.40397917702171048937e-01,
+ 7.18286544141962662868e-02,
+ 1.26171219808761642112e-01,
+ 1.36370839120290507362e-02,
+ 1.19844998467991074170e-02};
+ private final static double e_erx=8.45062911510467529297e-01;
+
+ /**
+ * Error function.
+ * Based on C-code for the error function developed at Sun Microsystems.
+ * @author Jaco van Kooten
+ */
+ public static double error(double x) {
+ double P,Q,s,retval;
+ final double abs_x = (x >= 0.0 ? x : -x);
+ if ( abs_x < 0.84375 ) { // 0 < |x| < 0.84375
+ if (abs_x < 3.7252902984619141e-9 ) // |x| < 2**-28
+ retval = abs_x + abs_x*e_efx;
+ else {
+ s = x*x;
+ P = ePp[0]+s*(ePp[1]+s*(ePp[2]+s*(ePp[3]+s*ePp[4])));
+ Q = 1.0+s*(eQq[0]+s*(eQq[1]+s*(eQq[2]+s*(eQq[3]+s*eQq[4]))));
+ retval = abs_x + abs_x*(P/Q);
+ }
+ } else if (abs_x < 1.25) { // 0.84375 < |x| < 1.25
+ s = abs_x-1.0;
+ P = ePa[0]+s*(ePa[1]+s*(ePa[2]+s*(ePa[3]+s*(ePa[4]+s*(ePa[5]+s*ePa[6])))));
+ Q = 1.0+s*(eQa[0]+s*(eQa[1]+s*(eQa[2]+s*(eQa[3]+s*(eQa[4]+s*eQa[5])))));
+ retval = e_erx + P/Q;
+ } else if (abs_x >= 6.0)
+ retval = 1.0;
+ else // 1.25 < |x| < 6.0
+ retval = 1.0-complementaryError(abs_x);
+ return (x >= 0.0) ? retval : -retval;
+ }
+
+// Coefficients for approximation to erfc in [1.25,1/.35]
+ private final static double eRa[]={
+ -9.86494403484714822705e-03,
+ -6.93858572707181764372e-01,
+ -1.05586262253232909814e01,
+ -6.23753324503260060396e01,
+ -1.62396669462573470355e02,
+ -1.84605092906711035994e02,
+ -8.12874355063065934246e01,
+ -9.81432934416914548592e00};
+ private final static double eSa[]={
+ 1.96512716674392571292e01,
+ 1.37657754143519042600e02,
+ 4.34565877475229228821e02,
+ 6.45387271733267880336e02,
+ 4.29008140027567833386e02,
+ 1.08635005541779435134e02,
+ 6.57024977031928170135e00,
+ -6.04244152148580987438e-02};
+// Coefficients for approximation to erfc in [1/.35,28]
+ private final static double eRb[]={
+ -9.86494292470009928597e-03,
+ -7.99283237680523006574e-01,
+ -1.77579549177547519889e01,
+ -1.60636384855821916062e02,
+ -6.37566443368389627722e02,
+ -1.02509513161107724954e03,
+ -4.83519191608651397019e02};
+ private final static double eSb[]={
+ 3.03380607434824582924e01,
+ 3.25792512996573918826e02,
+ 1.53672958608443695994e03,
+ 3.19985821950859553908e03,
+ 2.55305040643316442583e03,
+ 4.74528541206955367215e02,
+ -2.24409524465858183362e01};
+
+ /**
+ * Complementary error function.
+ * Based on C-code for the error function developed at Sun Microsystems.
+ * @author Jaco van Kooten
+ */
+ public static double complementaryError(double x) {
+ double s,retval,R,S;
+ final double abs_x =(x>=0.0 ? x : -x);
+ if (abs_x < 1.25)
+ retval = 1.0-error(abs_x);
+ else if (abs_x > 28.0)
+ retval=0.0;
+ else { // 1.25 < |x| < 28
+ s = 1.0/(abs_x*abs_x);
+ if (abs_x < 2.8571428) { // ( |x| < 1/0.35 )
+ R=eRa[0]+s*(eRa[1]+s*(eRa[2]+s*(eRa[3]+s*(eRa[4]+s*(eRa[5]+s*(eRa[6]+s*eRa[7]))))));
+ S=1.0+s*(eSa[0]+s*(eSa[1]+s*(eSa[2]+s*(eSa[3]+s*(eSa[4]+s*(eSa[5]+s*(eSa[6]+s*eSa[7])))))));
+ } else { // ( |x| > 1/0.35 )
+ R=eRb[0]+s*(eRb[1]+s*(eRb[2]+s*(eRb[3]+s*(eRb[4]+s*(eRb[5]+s*eRb[6])))));
+ S=1.0+s*(eSb[0]+s*(eSb[1]+s*(eSb[2]+s*(eSb[3]+s*(eSb[4]+s*(eSb[5]+s*eSb[6]))))));
+ }
+ retval = Math.exp(-x*x - 0.5625 + R/S)/abs_x;
+ }
+ return (x >= 0.0) ? retval : 2.0-retval;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/TDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/TDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/TDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/TDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,61 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The TDistribution class provides an object for encapsulating student's t-distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class TDistribution extends ProbabilityDistribution {
+ private int dgrFreedom;
+ private double logPdfFreedom;
+
+ /**
+ * Constructor for student's t-distribution.
+ * @param r degrees of freedom.
+ */
+ public TDistribution(int r) {
+ if(r<=0)
+ throw new OutOfRangeException("The degrees of freedom must be greater than zero.");
+ dgrFreedom=r;
+ logPdfFreedom=-SpecialMath.logBeta(0.5*dgrFreedom,0.5)-0.5*Math.log(dgrFreedom);
+ }
+ /**
+ * Returns the degrees of freedom.
+ */
+ public int getDegreesOfFreedom() {
+ return dgrFreedom;
+ }
+ /**
+ * Probability density function of a student's t-distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ double logPdf=logPdfFreedom;
+ logPdf-=(0.5*(dgrFreedom+1))*Math.log(1.0+(X*X)/dgrFreedom);
+ return Math.exp(logPdf);
+ }
+ /**
+ * Cumulative student's t-distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ double A=0.5*SpecialMath.incompleteBeta((dgrFreedom)/(dgrFreedom+X*X),0.5*dgrFreedom,0.5);
+ return X>0 ? 1-A : A;
+ }
+ /**
+ * Inverse of the cumulative student's t-distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ if(probability==0.0)
+ return -Double.MAX_VALUE;
+ if(probability==1.0)
+ return Double.MAX_VALUE;
+ if(probability==0.5)
+ return 0.0;
+ return findRoot(probability, 0.0, -0.5*Double.MAX_VALUE, 0.5*Double.MAX_VALUE);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/WeibullDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/WeibullDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/WeibullDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/WeibullDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,68 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The WeibullDistribution class provides an object for encapsulating Weibull distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class WeibullDistribution extends ProbabilityDistribution {
+ private double shape;
+
+ /**
+ * Constructs a Weibull distribution.
+ * @param sh the shape.
+ */
+ public WeibullDistribution(double sh) {
+ if(sh<=0.0)
+ throw new OutOfRangeException("The shape parameter should be positive.");
+ shape=sh;
+ }
+ /**
+ * Returns the shape parameter.
+ */
+ public double getShapeParameter() {
+ return shape;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return SpecialMath.gamma(1.0+1.0/shape);
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return SpecialMath.gamma(1.0+2.0/shape)-getMean()*getMean();
+ }
+ /**
+ * Probability density function of a Weibull distribution.
+ * P(X) = s Xs-1 exp(-Xs).
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ final double XpowShape=Math.pow(X,shape);
+ return shape*XpowShape/X*Math.exp(-XpowShape);
+ }
+ /**
+ * Cumulative Weibull distribution function.
+ * @param X should be integer-valued.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return 1.0-Math.exp(-Math.pow(X,shape));
+ }
+ /**
+ * Inverse of the cumulative Weibull distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return Math.pow(-Math.log(1.0-probability),1.0/shape);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Beta.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Beta.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Beta.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Beta.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,571 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Beta
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double a, double b);
+ *
+ * DESCRIPTION
+ *
+ * The density of the Beta distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double a, double b)
+ {
+ double y;
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b)) return x + a + b;
+ /*!* #endif /*4!*/
+ if (a <= 0.0 || b <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0)
+ return 0;
+ if (x > 1)
+ return 0;
+ y = Misc.beta(a, b);
+/*!* a = pow(x, a - 1); *!*/
+ a = java.lang.Math.pow(x, a - 1);
+/*!* b = pow(1.0 - x, b - 1.0); *!*/
+ b = java.lang.Math.pow(1.0 - x, b - 1.0);
+ /*!* #ifndef IEEE_754 /*4!*/
+ // if(errno) return Double.NaN;
+ /*!* #endif /*4!*/
+ return a * b / y;
+ }
+
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double pin, double qin);
+ *
+ * DESCRIPTION
+ *
+ * Returns distribution function of the Beta distribution.
+ * (The incomplete Beta ratio).
+ *
+ * NOTES
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ *
+ * REFERENCE
+ *
+ * Bosten and Battiste (1974).
+ * Remark on Algorithm 179,
+ * CACM 17, p153, (1974).
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+
+
+ static double pbeta_raw(double x, double pin, double qin)
+ {
+ double ans, c, finsum, p, ps, p1, q, term, xb, xi, y;
+ int n, i, ib;
+ double eps = 0;
+ double alneps = 0;
+ double sml = 0;
+ double alnsml = 0;
+
+ if (eps == 0) {
+ eps = Misc.d1mach(3);
+/*!* alneps = log(eps); *!*/
+ alneps = java.lang.Math.log(eps);
+ sml = Misc.d1mach(1);
+/*!* alnsml = log(sml); *!*/
+ alnsml = java.lang.Math.log(sml);
+ }
+
+ y = x;
+ p = pin;
+ q = qin;
+
+ /* swap tails if x is greater than the mean */
+
+ if (p / (p + q) < x) {
+ y = 1 - y;
+ p = qin;
+ q = pin;
+ }
+
+ if ((p + q) * y / (p + 1) < eps) {
+
+ /* tail approximation */
+
+ ans = 0;
+/*!* xb = p * log(Math.max(y, sml)) - log(p) - Misc.lbeta(p, q); *!*/
+ xb = p * java.lang.Math.log(Math.max(y, sml)) - java.lang.Math.log(p) - Misc.lbeta(p, q);
+ if (xb > alnsml && y != 0)
+/*!* ans = exp(xb); *!*/
+ ans = java.lang.Math.exp(xb);
+ if (y != x || p != pin)
+ ans = 1 - ans;
+ }
+ else {
+
+ /* evaluate the infinite sum first. term will equal */
+ /* y^p / Beta(ps, p) * (1 - ps)-sub-i * y^i / fac(i) */
+
+/*!* ps = q - floor(q); *!*/
+ ps = q - java.lang.Math.floor(q);
+ if (ps == 0)
+ ps = 1;
+/*!* xb = p * log(y) - Misc.lbeta(ps, p) - log(p); *!*/
+ xb = p * java.lang.Math.log(y) - Misc.lbeta(ps, p) - java.lang.Math.log(p);
+ ans = 0;
+ if (xb >= alnsml) {
+/*!* ans = exp(xb); *!*/
+ ans = java.lang.Math.exp(xb);
+ term = ans * p;
+ if (ps != 1) {
+ n = (int) Math.max(alneps/java.lang.Math.log(y), 4.0);
+ for(i=1 ; i<= n ; i++) {
+ xi = i;
+ term = term * (xi - ps) * y / xi;
+ ans = ans + term / (p + xi);
+ }
+ }
+ }
+
+ /* now evaluate the finite sum, maybe. */
+
+ if (q > 1) {
+/*!* xb = p * log(y) + q * log(1 - y) - Misc.lbeta(p, q) - log(q); *!*/
+ xb = p * java.lang.Math.log(y) + q * java.lang.Math.log(1 - y) - Misc.lbeta(p, q) - java.lang.Math.log(q);
+ ib = (int) Math.max(xb / alnsml, 0.0);
+/*!* term = exp(xb - ib * alnsml); *!*/
+ term = java.lang.Math.exp(xb - ib * alnsml);
+ c = 1 / (1 - y);
+ p1 = q * c / (p + q - 1);
+
+ finsum = 0;
+ n = (int) q;
+ if (q == n)
+ n = n - 1;
+ for(i=1 ; i<=n ; i++) {
+ if (p1 <= 1 && term / eps <= finsum)
+ break;
+ xi = i;
+ term = (q - xi + 1) * c * term / (p + q - xi);
+ if (term > 1) {
+ ib = ib - 1;
+ term = term * sml;
+ }
+ if (ib == 0)
+ finsum = finsum + term;
+ }
+ ans = ans + finsum;
+ }
+ if (y != x || p != pin)
+ ans = 1 - ans;
+ ans = Math.max(Math.min(ans, 1.0), 0.0);
+ }
+ return ans;
+ }
+
+ public static double cumulative(double x, double pin, double qin)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(pin) || Double.isNaN(qin))
+ return x + pin + qin;
+ /*!* #endif /*4!*/
+
+ if (pin <= 0 || qin <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0)
+ return 0;
+ if (x >= 1)
+ return 1;
+ return pbeta_raw(x, pin, qin);
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+
+ * Reference:
+ * Cran, G. W., K. J. Martin and G. E. Thomas (1977).
+ * Remark AS R19 and Algorithm AS 109,
+ * Applied Statistics, 26(1), 111-114.
+ * Remark AS R83 (v.39, 309-310) and the correction (v.40(1) p.236)
+ * have been incorporated in this version.
+ */
+
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static double zero = 0.0;
+
+ /* set the exponent of accu to -2r-2 for r digits of accuracy */
+ /*!* #ifdef OLD
+ static double acu = 1.0e-32;
+ static double lower = 0.0001;
+ static double upper = 0.9999;
+ *4!*/
+ /*!* #else/*---- NEW ---- -- still fails for p = 1e11, q=.5*/ /*4!*/
+
+ static double fpu = 3e-308;
+ /* acu_min: Minimal value for accuracy 'acu' which will depend on (a,p);
+ acu_min >= fpu ! */
+ static double acu_min = 1e-300;
+ static double lower = fpu;
+ static double upper = 1-2.22e-16;
+
+ /*!* #endif /*4!*/
+
+ static double const1 = 2.30753;
+ static double const2 = 0.27061;
+ static double const3 = 0.99229;
+ static double const4 = 0.04481;
+
+ static volatile double xtrunc;
+
+ public static double quantile(double alpha, double p, double q)
+ {
+ int swap_tail, i_pb, i_inn;
+ double a, adj, logbeta, g, h, pp, prev, qq, r, s, t, tx, w, y, yprev;
+ double acu;
+ double xinbta;
+
+ /* define accuracy and initialize */
+
+ xinbta = alpha;
+
+ /* test for admissibility of parameters */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(p) || Double.isNaN(q) || Double.isNaN(alpha))
+ return p + q + alpha;
+ /*!* #endif /*4!*/
+ if(p < zero || q < zero || alpha < zero || alpha > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (alpha == zero || alpha == 1)
+ return alpha;
+
+ logbeta = Misc.lbeta(p, q);
+
+ /* change tail if necessary; afterwards 0 < a <= 1/2 */
+ if (alpha <= 0.5) {
+ a = alpha; pp = p; qq = q; swap_tail = 0;
+ } else { /* change tail, swap p <-> q :*/
+ a = 1 - alpha; pp = q; qq = p; swap_tail = 1;
+ }
+
+ /* calculate the initial approximation */
+
+/*!* r = sqrt(-log(a * a)); *!*/
+ r = java.lang.Math.sqrt(-java.lang.Math.log(a * a));
+ y = r - (const1 + const2 * r) / (1 + (const3 + const4 * r) * r);
+ if (pp > 1 && qq > 1) {
+ r = (y * y - 3) / 6;
+ s = 1 / (pp + pp - 1);
+ t = 1 / (qq + qq - 1);
+ h = 2 / (s + t);
+/*!* w = y * sqrt(h + r) / h - (t - s) * (r + 5 / 6 - 2 / (3 * h)); *!*/
+ w = y * java.lang.Math.sqrt(h + r) / h - (t - s) * (r + 5 / 6 - 2 / (3 * h));
+/*!* xinbta = pp / (pp + qq * exp(w + w)); *!*/
+ xinbta = pp / (pp + qq * java.lang.Math.exp(w + w));
+ } else {
+ r = qq + qq;
+ t = 1 / (9 * qq);
+/*!* t = r * pow(1 - t + y * sqrt(t), 3); *!*/
+ t = r * java.lang.Math.pow(1 - t + y * java.lang.Math.sqrt(t), 3);
+ if (t <= zero)
+/*!* xinbta = 1 - exp((log((1 - a) * qq) + logbeta) / qq); *!*/
+ xinbta = 1 - java.lang.Math.exp((java.lang.Math.log((1 - a) * qq) + logbeta) / qq);
+ else {
+ t = (4 * pp + r - 2) / t;
+ if (t <= 1)
+/*!* xinbta = exp((log(a * pp) + logbeta) / pp); *!*/
+ xinbta = java.lang.Math.exp((java.lang.Math.log(a * pp) + logbeta) / pp);
+ else
+ xinbta = 1 - 2 / (t + 1);
+ }
+ }
+
+ /* solve for x by a modified newton-raphson method, */
+ /* using the function pbeta_raw */
+
+ r = 1 - pp;
+ t = 1 - qq;
+ yprev = zero;
+ adj = 1;
+ if (xinbta < lower)
+ xinbta = lower;
+ else if (xinbta > upper)
+ xinbta = upper;
+
+ /* Desired accuracy should depend on (a,p)
+ * This is from Remark .. on AS 109, adapted.
+ * However, it's not clear if this is "optimal" for IEEE double prec.
+
+ * acu = Math.max(acu_min, pow(10., -25. - 5./(pp * pp) - 1./(a * a)));
+
+ * NEW: 'acu' accuracy NOT for squared adjustment, but simple;
+ * ---- i.e., "new acu" = sqrt(old acu)
+
+ */
+ acu = Math.max(acu_min, java.lang.Math.pow(10., -13 - 2.5/(pp * pp) - 0.5/(a * a)));
+ tx = prev = zero; /* keep -Wall happy */
+
+L_converged: {
+ for (i_pb=0; i_pb < 1000; i_pb++) {
+ y = pbeta_raw(xinbta, pp, qq);
+ /* y = pbeta_raw2(xinbta, pp, qq, logbeta); */
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(y))
+ /*!* #else /*4!*/
+ // if (errno)
+ /*!* #endif /*4!*/
+ // { throw new java.lang.ArithmeticException("Math Error: DOMAIN"); return Double.NaN; }
+ y = (y - a) *
+/*!* exp(logbeta + r * log(xinbta) + t * log(1 - xinbta)); *!*/
+ java.lang.Math.exp(logbeta + r * java.lang.Math.log(xinbta) + t * java.lang.Math.log(1 - xinbta));
+ if (y * yprev <= zero)
+ prev = Math.max(java.lang.Math.abs(adj),fpu);
+ g = 1;
+ for (i_inn=0; i_inn < 1000;i_inn++) {
+ adj = g * y;
+ if (java.lang.Math.abs(adj) < prev) {
+ tx = xinbta - adj; /* trial new x */
+ if (tx >= zero && tx <= 1) {
+ if (prev <= acu) break L_converged;
+ if (java.lang.Math.abs(y) <= acu) break L_converged;
+ if (tx != zero && tx != 1)
+ break;
+ }
+ }
+ g /= 3;
+ }
+ xtrunc = tx; /* this prevents trouble with excess FPU */
+ /* precision on some machines. */
+ if (xtrunc == xinbta)
+ break L_converged;
+ xinbta = tx;
+ yprev = y;
+ }
+ /*-- NOT converged: Iteration count --*/
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+
+ if (swap_tail==1)
+ xinbta = 1 - xinbta;
+ return xinbta;
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /* Reference:
+ * R. C. H. Cheng (1978).
+ * Generating Beta variates with nonintegral shape parameters.
+ * Communications of the ACM 21, 317-322.
+ * (Algorithms BB and BC)
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+/*!* double random(double aa, double bb) *!*/
+ public static double random(double aa, double bb, Uniform uniformDistribution)
+ {
+ int qsame;
+
+ double expmax = 0.0;
+ double a=0.0, b=0.0, delta=0.0, r=0.0, s=0.0, t=0.0, u1=0.0;
+ double u2=0.0, v=0.0, w=0.0, y=0.0, z=0.0;
+ double alpha=0.0, beta=0.0, gamma=0.0, k1=0.0, k2=0.0;
+ double olda = -1.0;
+ double oldb = -1.0;
+
+
+
+ if (expmax == 0.0)
+/*!* expmax = log(Double.MAX_VALUE); *!*/
+ expmax = java.lang.Math.log(Double.MAX_VALUE);
+
+ /*!* qsame = (olda == aa) && (oldb == bb); *!*/
+ qsame = ( (olda == aa) && (oldb == bb) )?1:0;
+
+ if (!(qsame==1)) {
+ if (aa > 0.0 && bb > 0.0) {
+ olda = aa;
+ oldb = bb;
+ } else {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ }
+
+ deliver: {
+
+ if (Math.min(aa, bb) <= 1.0) { /* Algorithm BC */
+ if (!(qsame==1)) {
+ a = Math.max(aa, bb);
+ b = Math.min(aa, bb);
+ alpha = a + b;
+ beta = 1.0 / b;
+ delta = 1.0 + a - b;
+ k1 = delta * (0.0138889 + 0.0416667 * b) /
+ (a * beta - 0.777778);
+ k2 = 0.25 + (0.5 + 0.25 / delta) * b;
+ }
+ for(;;) {
+ u1 = uniformDistribution.random();
+ u2 = uniformDistribution.random();
+
+ if (u1 < 0.5) {
+ y = u1 * u2;
+ z = u1 * y;
+ if (0.25 * u2 + z - y >= k1)
+ continue;
+ } else {
+ z = u1 * u1 * u2;
+ if (z <= 0.25)
+ break;
+ if (z >= k2)
+ continue;
+ }
+/*!* v = Beta * log(u1 / (1.0 - u1)); *!*/
+ v = beta * java.lang.Math.log(u1 / (1.0 - u1));
+ if (v <= expmax)
+/*!* w = a * exp(v); *!*/
+ w = a * java.lang.Math.exp(v);
+ else
+ w = Double.MAX_VALUE;
+/*!* if (alpha * (log(alpha / (b + w)) + v) - 1.3862944 *!*/
+ if (alpha * (java.lang.Math.log(alpha / (b + w)) + v) - 1.3862944
+/*!* >= log(z)) *!*/
+ >= java.lang.Math.log(z))
+ break deliver;
+ }
+/*!* v = Beta * log(u1 / (1.0 - u1)); *!*/
+ v = beta * java.lang.Math.log(u1 / (1.0 - u1));
+ if (v <= expmax)
+/*!* w = a * exp(v); *!*/
+ w = a * java.lang.Math.exp(v);
+ else
+ w = Double.MAX_VALUE;
+ } else { /* Algorithm BB */
+ if (!(qsame==1)) {
+ a = Math.min(aa, bb);
+ b = Math.max(aa, bb);
+ alpha = a + b;
+/*!* Beta = sqrt((alpha - 2.0) / (2.0 * a * b - alpha)); *!*/
+ beta = java.lang.Math.sqrt((alpha - 2.0) / (2.0 * a * b - alpha));
+ gamma = a + 1.0 / beta;
+ }
+ do {
+/*!* u1 = uniformDistribution.random(); *!*/
+ u1 = uniformDistribution.random();
+/*!* u2 = uniformDistribution.random(); *!*/
+ u2 = uniformDistribution.random();
+/*!* v = Beta * log(u1 / (1.0 - u1)); *!*/
+ v = beta * java.lang.Math.log(u1 / (1.0 - u1));
+ if (v <= expmax)
+/*!* w = a * exp(v); *!*/
+ w = a * java.lang.Math.exp(v);
+ else
+ w = Double.MAX_VALUE;
+ z = u1 * u1 * u2;
+ r = gamma * v - 1.3862944;
+ s = a + r - w;
+ if (s + 2.609438 >= 5.0 * z)
+ break;
+/*!* t = log(z); *!*/
+ t = java.lang.Math.log(z);
+ if (s > t)
+ break;
+ }
+/*!* while (r + alpha * log(alpha / (b + w)) < t); *!*/
+ while (r + alpha * java.lang.Math.log(alpha / (b + w)) < t);
+ }
+
+ } // deliver:
+ return (aa != a) ? b / (b + w) : w / (b + w);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Binomial.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Binomial.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Binomial.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Binomial.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,418 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Binomial
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n, double p)
+ *
+ * DESCRIPTION
+ *
+ * The density of the Binomial distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double n, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p)) return x + n + p;
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if(n <= 0 || p < 0 || p > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if (x < 0 || x > n)
+ return 0;
+ if (p == 0)
+ return (x == 0) ? 1 : 0;
+ if (p == 1)
+ return (x == n) ? 1 : 0;
+/*!* return exp(lfastchoose(n, x) + log(p) * x + (n - x) * log(1 - p)); *!*/
+ return java.lang.Math.exp(Misc.lfastchoose(n, x) + java.lang.Math.log(p) * x + (n - x) * java.lang.Math.log(1 - p));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double n, double p)
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Binomial distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p))
+ return x + n + p;
+ if (Double.isInfinite(n) || Double.isInfinite(p)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if(n <= 0 || p < 0 || p > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* x = floor(x); *!*/
+ x = java.lang.Math.floor(x);
+ if (x < 0.0) return 0;
+ if (n <= x) return 1;
+ return Beta.cumulative(1.0 - p, n - x, x + 1);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double n, double p);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Binomial distribution.
+ *
+ * NOTES
+ *
+ * The function uses the Cornish-Fisher Expansion to include
+ * a skewness correction to a Normal approximation. This gives
+ * an initial value which never seems to be off by more than
+ * 1 or 2. A search is then conducted of values close to
+ * this initial start point.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double n, double p)
+ {
+ double q, mu, sigma, gamma, z, y;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p))
+ return x + n + p;
+ if(Double.isInfinite(x) || Double.isInfinite(n) || Double.isInfinite(p)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (x < 0 || x > 1 || p <= 0 || p >= 1 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 0) return 0.0;
+ if (x == 1) return n;
+ q = 1 - p;
+ mu = n * p;
+/*!* sigma = sqrt(n * p * q); *!*/
+ sigma = java.lang.Math.sqrt(n * p * q);
+ gamma = (q-p)/sigma;
+ z = Normal.quantile(x, 0.0, 1.0);
+/*!* y = floor(mu + sigma * (z + gamma * (z*z - 1) / 6) + 0.5); *!*/
+ y = java.lang.Math.floor(mu + sigma * (z + gamma * (z*z - 1) / 6) + 0.5);
+
+ z = cumulative(y, n, p);
+ if(z >= x) {
+
+ /* search to the left */
+
+ for(;;) {
+ if((z = cumulative(y - 1, n, p)) < x)
+ return y;
+ y = y - 1;
+ }
+ }
+ else {
+
+ /* search to the right */
+
+ for(;;) {
+ if((z = cumulative(y + 1, n, p)) >= x)
+ return y + 1;
+ y = y + 1;
+ }
+ }
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double nin, double pp)
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Binomial distribution.
+ *
+ * REFERENCE
+ *
+ * Kachitvichyanukul, V. and Schmeiser, B. W. (1988).
+ * Binomial random variate generation.
+ * Communications of the ACM 31, p216.
+ * (Algorithm BTPEC).
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+ /*!* #include /*4!*/
+
+
+ public static double random(double nin, double pp, Uniform uniformDistribution)
+ {
+ double al=0.0, alv=0.0, amaxp=0.0, c=0.0, f=0.0, f1=0.0;
+ double f2=0.0, ffm=0.0, fm=0.0, g=0.0;
+ double p1=0.0, p2=0.0, p3=0.0, p4=0.0, qn=0.0, r=0.0;
+ double u=0.0, v=0.0, w=0.0, w2=0.0;
+ double x=0.0, x1=0.0, x2=0.0, xl=0.0, xll=0.0, xlr=0.0;
+ double xm=0.0, xnp=0.0, xnpq=0.0, xr=0.0, ynorm=0.0, z=0.0, z2=0.0;
+ int i=0, ix=0, ix1=0, k=0, m=0, mp=0, n=0;
+ double p=0.0, q=0.0;
+ double psave = -1.0;
+ int nsave = -1;
+
+
+/*!* n = floor(nin + 0.5); *!*/
+ n = (int) java.lang.Math.floor(nin + 0.5);
+ /* n=0, p=0, p=1 are not errors */
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(n) || Double.isInfinite(pp) ||
+ /*!* #endif /*4!*/
+ n < 0.0 || pp < 0.0 || pp > 1.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (n==0.0 || pp==0) return 0;
+ if (pp==1.0) return n;
+
+ /* setup, perform only when parameters change */
+
+ L30: {
+ L20: {
+ L10: {
+ if (pp != psave) {
+ psave = pp;
+/*!* p = fmin2(psave, 1.0 - psave); *!*/
+ p = Math.min(psave, 1.0 - psave);
+ q = 1.0 - p;
+ } else if (n == nsave) {
+ if (xnp < 30.0)
+ break L20;
+ break L10;
+ }
+ xnp = n * p;
+ nsave = n;
+ if (xnp < 30.0) {
+ /* inverse cdf logic for mean less than 30 */
+/*!* qn = pow(q, (double) n); *!*/
+ qn = java.lang.Math.pow(q, (double) n);
+ r = p / q;
+ g = r * (n + 1);
+ break L20;
+ } else {
+ ffm = xnp + p;
+ m = (int) ffm;
+ fm = m;
+ xnpq = xnp * q;
+/*!* p1 = (int)(2.195 * sqrt(xnpq) - 4.6 * q) + 0.5; *!*/
+ p1 = (int)(2.195 * java.lang.Math.sqrt(xnpq) - 4.6 * q) + 0.5;
+ xm = fm + 0.5;
+ xl = xm - p1;
+ xr = xm + p1;
+ c = 0.134 + 20.5 / (15.3 + fm);
+ al = (ffm - xl) / (ffm - xl * p);
+ xll = al * (1.0 + 0.5 * al);
+ al = (xr - ffm) / (xr * q);
+ xlr = al * (1.0 + 0.5 * al);
+ p2 = p1 * (1.0 + c + c);
+ p3 = p2 + c / xll;
+ p4 = p3 + c / xlr;
+ }
+ }
+ // L10:
+ while(true) {
+ u = uniformDistribution.random() * p4;
+ v = uniformDistribution.random();
+ /* triangular region */
+ if (u <= p1) {
+ ix = (int) (xm - p1 * v + u);
+ break L30;
+ }
+ /* parallelogram region */
+ if (u <= p2) {
+ x = xl + (u - p1) / c;
+/*!* v = v * c + 1.0 - fabs(xm - x) / p1; *!*/
+ v = v * c + 1.0 - java.lang.Math.abs(xm - x) / p1;
+ if (v > 1.0 || v <= 0.)
+ continue;
+ ix = (int) x;
+ } else {
+ if (u > p3) { /* right tail */
+/*!* ix = xr - log(v) / xlr; *!*/
+ ix = (int)( xr - java.lang.Math.log(v) / xlr);
+ if (ix > n)
+ continue;
+ v = v * (u - p3) * xlr;
+ } else {/* left tail */
+/*!* ix = xl + log(v) / xll; *!*/
+ ix = (int) (xl + java.lang.Math.log(v) / xll);
+ if (ix < 0)
+ continue;
+ v = v * (u - p2) * xll;
+ }
+ }
+ /* determine appropriate way to perform accept/reject test */
+/*!* k = abs(ix - m); *!*/
+ k = java.lang.Math.abs(ix - m);
+ if (k <= 20 || k >= xnpq / 2 - 1) {
+ /* explicit evaluation */
+ f = 1.0;
+ r = p / q;
+ g = (n + 1) * r;
+ if (m < ix) {
+ mp = m + 1;
+ for (i = mp; i <= ix; i++)
+ f = f * (g / i - r);
+ } else if (m != ix) {
+ ix1 = ix + 1;
+ for (i = ix1; i <= m; i++)
+ f = f / (g / i - r);
+ }
+ if (v <= f)
+ break L30;
+ } else {
+ /* squeezing using upper and lower bounds */
+ /* on log(f(x)) */
+ amaxp = (k / xnpq) * ((k * (k / 3.0 + 0.625) + 0.1666666666666) / xnpq + 0.5);
+ ynorm = -k * k / (2.0 * xnpq);
+/*!* alv = log(v); *!*/
+ alv = java.lang.Math.log(v);
+ if (alv < ynorm - amaxp)
+ break L30;
+ if (alv <= ynorm + amaxp) {
+ /* stirling's formula to machine accuracy */
+ /* for the final acceptance/rejection test */
+ x1 = ix + 1;
+ f1 = fm + 1.0;
+ z = n + 1 - fm;
+ w = n - ix + 1.0;
+ z2 = z * z;
+ x2 = x1 * x1;
+ f2 = f1 * f1;
+ w2 = w * w;
+/*!* if (alv <= xm * log(f1 / x1) + (n - m + 0.5) * log(z / w) + (ix - m) * log(w * p / x1 * q) + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / f2) / f2) / f2) / f2) / f1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / z2) / z2) / z2) / z2) / z / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / x2) / x2) / x2) / x2) / x1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / w2) / w2) / w2) / w2) / w / 166320.) *!*/
+ if (alv <= xm * java.lang.Math.log(f1 / x1) + (n - m + 0.5) * java.lang.Math.log(z / w) + (ix - m) * java.lang.Math.log(w * p / x1 * q) + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / f2) / f2) / f2) / f2) / f1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / z2) / z2) / z2) / z2) / z / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / x2) / x2) / x2) / x2) / x1 / 166320.0 + (13860.0 - (462.0 - (132.0 - (99.0 - 140.0 / w2) / w2) / w2) / w2) / w / 166320.)
+ break L30;
+ }
+ }
+ }
+ }
+ // L20:
+ while(true) {
+ ix = 0;
+ f = qn;
+ u = uniformDistribution.random();
+ while(true) {
+ if (u < f)
+ break L30;
+ if (ix > 110)
+ break;
+ u = u - f;
+ ix = ix + 1;
+ f = f * (g / ix - r);
+ }
+ }
+ }
+ // L30:
+ if (psave > 0.5)
+ ix = n - ix;
+ return (double)ix;
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Cauchy.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Cauchy.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Cauchy.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Cauchy.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,199 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Cauchy
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double location, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The density of the Cauchy distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double location, double scale)
+ {
+ double y;
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ /*!* #endif /*4!*/
+ if (scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ y = (x - location) / scale;
+ return 1.0 / (Constants.M_PI * scale * (1.0 + y * y));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double location, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Cauchy distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double location, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ /*!* #endif /*4!*/
+ if (scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ x = (x - location) / scale;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x)) {
+ if(x < 0) return 0;
+ else return 1;
+ }
+ /*!* #endif /*4!*/
+/*!* return 0.5 + atan(x) / Constants.M_PI; *!*/
+ return 0.5 + java.lang.Math.atan(x) / Constants.M_PI;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double location, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Cauchy distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double location, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ if(Double.isInfinite(x) || Double.isInfinite(location) || Double.isInfinite(scale)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+ if (scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* return location + scale * tan(Constants.M_PI * (x - 0.5)); *!*/
+ return location + scale * java.lang.Math.tan(Constants.M_PI * (x - 0.5));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double location, double scale);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the normal distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double location, double scale, Uniform uniformDistribution)
+ {
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(location) || Double.isInfinite(scale) ||
+ /*!* #endif /*4!*/
+ scale < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* return location + scale * tan(Constants.M_PI * sunif()); *!*/
+ return location + scale * java.lang.Math.tan(Constants.M_PI * uniformDistribution.random());
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Chisquare.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Chisquare.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Chisquare.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Chisquare.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,164 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Chisquare
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double df)
+ *
+ * DESCRIPTION
+ *
+ * The density of the chi-squared disribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double df)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ /*!* #endif /*4!*/
+ return Gamma.density(x, df / 2.0, 2.0);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double df);
+ *
+ * DESCRIPTION
+ *
+ * The disribution function of the chi-squared distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double df)
+ {
+ return Gamma.cumulative(x, df / 2.0, 2.0);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double p, double df);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the chi-squared distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double p, double df)
+ {
+ return Gamma.quantile(p, 0.5 * df, 2.0);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double df);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the chi-squared distribution.
+ *
+ * NOTES
+ *
+ * Calls rgamma to do the real work.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double df, Uniform uniformDistribution)
+ {
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(df) ||
+ /*!* #endif /*4!*/
+ df <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ return Gamma.random(df / 2.0, 2.0, uniformDistribution);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Constants.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Constants.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Constants.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Constants.java 2010-01-27 09:33:28.000000000 +0000
@@ -0,0 +1,95 @@
+/* DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+
+package org.mathpiper.builtin.library.statdistlib;
+
+/**
+ * Class defining constants.
+ */
+
+public class Constants {
+
+ /* 30 Decimal-place constants computed with bc -l (scale=32; proper round) */
+
+ public static final double M_SQRT_2 = 1.4142135623730950488016887242097;
+ /* 1/sqrt(2) */
+ public static final double M_1_SQRT_2 = 0.707106781186547524400844362105;
+ /* sqrt(32) */
+ public static final double M_SQRT_32 = 5.656854249492380195206754896838;
+
+ public static final double M_LN_2 = 0.693147180559945309417232121458176568;
+ public static final double M_LOG10_2 = 0.301029995663981195213738894724493027;
+
+ public static final double M_PI = 3.141592653589793238462643383279502884197169399375;
+ public static final double M_PI_half = 1.570796326794896619231321691640;
+
+ /* 1/pi */
+ public static final double M_1_PI = 0.31830988618379067153776752674502872406891929148;
+
+ /* pi/2 */
+ public static final double M_PI_2 = 1.57079632679489661923132169163975144209858469969;
+
+ /* sqrt(pi), 1/sqrt(2pi), sqrt(2/pi) : */
+ public static final double M_SQRT_PI = 1.772453850905516027298167483341;
+ public static final double M_1_SQRT_2PI = 0.398942280401432677939946059934;
+ public static final double M_SQRT_2dPI = 0.79788456080286535587989211986876;
+
+ /* log(sqrt(pi)) = log(pi)/2 : */
+ public static final double M_LN_SQRT_PI = 0.5723649429247000870717136756765293558;
+ /* log(sqrt(2*pi)) = log(2*pi)/2 : */
+ public static final double M_LN_SQRT_2PI = 0.91893853320467274178032973640562;
+ /* log(sqrt(pi/2)) = log(pi/2)/2 : */
+ public static final double M_LN_SQRT_PId2 = 0.225791352644727432363097614947441;
+
+ public static final double ME_NONE = 0;
+ public static final double ME_DOMAIN = 1;
+ public static final double ME_RANGE = 2;
+ public static final double ME_NOCONV = 3;
+ public static final double ME_PRECISION = 4;
+ public static final double ME_UNDERFLOW = 5;
+
+ /* constants taken from float.h for gcc 2.90.29 for Linux 2.0 i386 */
+ /* -- should match Java since both are supposed to be IEEE 754 compliant */
+
+ /* Radix of exponent representation */
+ public static final int FLT_RADIX = 2;
+
+ /* Difference between 1.0 and the minimum float/double greater than 1.0 */
+ public static final double FLT_EPSILON = 1.19209290e-07F;
+ public static final double DBL_EPSILON = 2.2204460492503131e-16;
+
+ /* Number of decimal digits of precision in a float/double */
+ public static final int FLT_DIG = 6;
+ public static final int DBL_DIG = 15;
+
+ /* Number of base-FLT_RADIX digits in the significand of a double */
+ public static final int FLT_MANT_DIG = 24;
+ public static final int DBL_MANT_DIG = 53;
+
+ /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */
+ public static final int FLT_MIN_EXP = -125;
+ public static final int DBL_MIN_EXP = -1021;
+
+ /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */
+ public static final int FLT_MAX_EXP = 128;
+ public static final int DBL_MAX_EXP = 1024;
+
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Exponential.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Exponential.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Exponential.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Exponential.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,138 @@
+/* DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+package org.mathpiper.builtin.library.statdistlib;
+
+/**
+ * Wrapper of functions for the Exponential distribution.
+ */
+
+public class Exponential {
+
+ /**
+ * Density of the Exponential distribution.
+ */
+ public static double density(double x, double scale) {
+ if (Double.isNaN(x) || Double.isNaN(scale)) return x + scale;
+ if (scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (x < 0.0) return 0.0;
+ return java.lang.Math.exp(-x / scale) / scale;
+ }
+
+ /**
+ * Distribution function of the Exponential distribution
+ *
+ */
+ public static double cumulative(double x, double scale) {
+ if (Double.isNaN(x) || Double.isNaN(scale))
+ return x + scale;
+ if (scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (x <= 0.0) return 0.0;
+ return 1.0 - java.lang.Math.exp(-x / scale);
+ }
+
+ /**
+ * quantile function of the Exponential distribution
+ */
+ public static double quantile(double x, double scale) {
+ if (Double.isNaN(x) || Double.isNaN(scale))
+ return x + scale;
+ if (scale <= 0 || x < 0 || x > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (x <= 0.0) return 0.0;
+ return - scale * java.lang.Math.log(1.0 - x);
+ }
+
+ /**
+ * Random variates from the Exponential distribution
+ */
+ public static double random(double scale, Uniform uniformDistribution) {
+ if (Double.isInfinite(scale) || scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ return scale * random(uniformDistribution);
+ }
+
+ /**
+ * Random variates from the standard normal distribution.
+ *
+ * Ahrens, J.H. and Dieter, U. (1972).
+ * Computer methods for sampling from the Exponential and
+ * normal distributions.
+ * Comm. ACM, 15, 873-882.
+ */
+
+ static private double q[] = {
+ 0.6931471805599453,
+ 0.9333736875190459,
+ 0.9888777961838675,
+ 0.9984959252914960,
+ 0.9998292811061389,
+ 0.9999833164100727,
+ 0.9999985691438767,
+ 0.9999998906925558,
+ 0.9999999924734159,
+ 0.9999999995283275,
+ 0.9999999999728814,
+ 0.9999999999985598,
+ 0.9999999999999289,
+ 0.9999999999999968,
+ 0.9999999999999999,
+ 1.0000000000000000
+ };
+
+
+ public static double random(Uniform uniformDistribution) {
+ /* q[k-1] = sum(alog(2.0)**k/k!) k=1,..,n, */
+ /* The highest n (here 8) is determined by q[n-1] = 1.0 */
+ /* within standard precision */
+ double a, u, ustar, umin;
+ int i;
+
+ a = 0.0;
+ u = uniformDistribution.random();
+ for (;;) {
+ u = u + u;
+ if (u > 1.0)
+ break;
+ a = a + q[0];
+ }
+ u = u - 1.0;
+
+ if (u <= q[0])
+ return a + u;
+
+ i = 0;
+ ustar = uniformDistribution.random();
+ umin = ustar;
+ do {
+ ustar = uniformDistribution.random();
+ if (ustar < umin)
+ umin = ustar;
+ i = i + 1;
+ } while (u > q[i]);
+ return a + umin * q[0];
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/F.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/F.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/F.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/F.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,201 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class F
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n1, double n2);
+ *
+ * DESCRIPTION
+ *
+ * The density function of the F distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double n1, double n2)
+ {
+ double a;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n1) || Double.isNaN(n2))
+ return x + n1 + n2;
+ /*!* #endif /*4!*/
+ if (n1 <= 0 || n2 <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0.0)
+ return 0.0;
+ a = (n1 / n2) * x;
+/*!* return pow(a, 0.5 * n1) * pow(1.0 + a, -0.5 * (n1 + n2)) *!*/
+ return java.lang.Math.pow(a, 0.5 * n1) * java.lang.Math.pow(1.0 + a, -0.5 * (n1 + n2))
+/*!* / (x * Beta(0.5 * n1, 0.5 * n2)); *!*/
+ / (x * Misc.beta(0.5 * n1, 0.5 * n2));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double n1, double n2);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the F distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n1, double n2)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n1) || Double.isNaN(n2))
+ return x + n2 + n1;
+ /*!* #endif /*4!*/
+ if (n1 <= 0.0 || n2 <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0.0)
+ return 0.0;
+ x = 1.0 - Beta.cumulative(n2 / (n2 + n1 * x), n2 / 2.0, n1 / 2.0);
+ return !Double.isNaN(x) ? x : Double.NaN;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double n1, double n2);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the F distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double n1, double n2)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n1) || Double.isNaN(n2))
+ return x + n1 + n2;
+ /*!* #endif /*4!*/
+ if (n1 <= 0.0 || n2 <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0.0)
+ return 0.0;
+ x = (1.0 / Beta.quantile(1.0 - x, n2 / 2.0, n1 / 2.0) - 1.0) * (n2 / n1);
+ return !Double.isNaN(x) ? x : Double.NaN;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "mathlib.h"
+ * double random(double dfn, double dfd);
+ *
+ * DESCRIPTION
+ *
+ * Pseudo-random variates from an F distribution.
+ *
+ * NOTES
+ *
+ * This function calls rchisq to do the real work
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double n1, double n2, Uniform uniformDistribution)
+ {
+ double v1, v2;
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isNaN(n1) || Double.isNaN(n2) ||
+ /*!* #endif /*4!*/
+ n1 <= 0.0 || n2 <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ v1 = !Double.isInfinite(n1) ? (Chisquare.random(n1,uniformDistribution) / n1) : Normal.random(uniformDistribution);
+ v2 = !Double.isInfinite(n2) ? (Chisquare.random(n2,uniformDistribution) / n2) : Normal.random(uniformDistribution);
+ return v1 / v2;
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Gamma.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Gamma.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Gamma.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Gamma.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,636 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+public class Gamma
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * Computes the density of the Gamma distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double shape, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(shape) || Double.isNaN(scale))
+ return x + shape + scale;
+ /*!* #endif /*4!*/
+ if (shape <= 0 || scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0)
+ return 0;
+ if (x == 0) {
+ if (shape < 1) {
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.POSITIVE_INFINITY;
+ }
+ if (shape > 1) {
+ return 0;
+ }
+ return 1 / scale;
+ }
+ x = x / scale;
+/*!* return exp((shape - 1) * log(x) - lgammafn(shape) - x) / scale; *!*/
+ return java.lang.Math.exp((shape - 1) * java.lang.Math.log(x) - Misc.lgammafn(shape) - x) / scale;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double a, double scale);
+ *
+ * DESCRIPTION
+ *
+ * This function computes the distribution function for the
+ * Gamma distribution with shape parameter a and scale parameter
+ * scale. This is also known as the incomplete Gamma function.
+ * See Abramowitz and Stegun (6.5.1) for example.
+ *
+ * NOTES
+ *
+ * This function is an adaptation of Algorithm 239 from the
+ * Applied Statistics Series. The algorithm is faster than
+ * those by W. Fullerton in the FNLIB library and also the
+ * TOMS 542 alorithm of W. Gautschi. It provides comparable
+ * accuracy to those algorithms and is considerably simpler.
+ *
+ * REFERENCES
+ *
+ * Algorithm 239, Incomplete Gamma Function
+ * Applied Statistics 37, 1988.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static private double
+ third = 1.0 / 3.0,
+ zero = 0.0,
+ one = 1.0,
+ two = 2.0,
+ oflo = 1.0e+37,
+ three = 3.0,
+ nine = 9.0,
+ xbig = 1.0e+8,
+ plimit = 1000.0e0,
+ elimit = -88.0e0;
+
+ public static double cumulative(double x, double p, double scale)
+ {
+ double pn1, pn2, pn3, pn4, pn5, pn6, arg, c, rn, a, b, an;
+ double sum;
+
+ /* check that we have valid values for x and p */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(p) || Double.isNaN(scale))
+ return x + p + scale;
+ /*!* #endif /*4!*/
+ if(p <= zero || scale <= zero) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ x = x / scale;
+ if (x <= zero)
+ return 0.0;
+
+ /* use a Normal approximation if p > plimit */
+
+ if (p > plimit) {
+/*!* pn1 = sqrt(p) * three * (pow(x/p, third) + one / (p * nine) - one); *!*/
+ pn1 = java.lang.Math.sqrt(p) * three * (java.lang.Math.pow(x/p, third) + one / (p * nine) - one);
+ return Normal.cumulative(pn1, 0.0, 1.0);
+ }
+
+ /* if x is extremely large compared to p then return 1 */
+
+ if (x > xbig)
+ return one;
+
+ if (x <= one || x < p) {
+
+ /* use pearson's series expansion. */
+
+/*!* arg = p * log(x) - x - lgammafn(p + one); *!*/
+ arg = p * java.lang.Math.log(x) - x - Misc.lgammafn(p + one);
+ c = one;
+ sum = one;
+ a = p;
+ do {
+ a = a + one;
+ c = c * x / a;
+ sum = sum + c;
+ } while (c > Constants.DBL_EPSILON);
+/*!* arg = arg + log(sum); *!*/
+ arg = arg + java.lang.Math.log(sum);
+ sum = zero;
+ if (arg >= elimit)
+/*!* sum = exp(arg); *!*/
+ sum = java.lang.Math.exp(arg);
+ } else {
+
+ /* use a continued fraction expansion */
+
+/*!* arg = p * log(x) - x - lgammafn(p); *!*/
+ arg = p * java.lang.Math.log(x) - x - Misc.lgammafn(p);
+ a = one - p;
+ b = a + x + one;
+ c = zero;
+ pn1 = one;
+ pn2 = x;
+ pn3 = x + one;
+ pn4 = x * b;
+ sum = pn3 / pn4;
+ for (;;) {
+ a = a + one;
+ b = b + two;
+ c = c + one;
+ an = a * c;
+ pn5 = b * pn3 - an * pn1;
+ pn6 = b * pn4 - an * pn2;
+/*!* if (fabs(pn6) > zero) { *!*/
+ if (java.lang.Math.abs(pn6) > zero) {
+ rn = pn5 / pn6;
+/*!* if (fabs(sum - rn) <= fmin2(Constants.DBL_EPSILON, Constants.DBL_EPSILON * rn)) *!*/
+ if (java.lang.Math.abs(sum - rn) <= Math.min(Constants.DBL_EPSILON, Constants.DBL_EPSILON * rn))
+ break;
+ sum = rn;
+ }
+ pn1 = pn3;
+ pn2 = pn4;
+ pn3 = pn5;
+ pn4 = pn6;
+/*!* if (fabs(pn5) >= oflo) { *!*/
+ if (java.lang.Math.abs(pn5) >= oflo) {
+
+ /* re-scale the terms in continued fraction */
+ /* if they are large */
+
+ pn1 = pn1 / oflo;
+ pn2 = pn2 / oflo;
+ pn3 = pn3 / oflo;
+ pn4 = pn4 / oflo;
+ }
+ }
+/*!* arg = arg + log(sum); *!*/
+ arg = arg + java.lang.Math.log(sum);
+ sum = one;
+ if (arg >= elimit)
+/*!* sum = one - exp(arg); *!*/
+ sum = one - java.lang.Math.exp(arg);
+ }
+ return sum;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double p, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * Compute the quantile function of the Gamma distribution.
+ *
+ * NOTES
+ *
+ * This function is based on the Applied Statistics
+ * Algorithm AS 91 and AS 239.
+ *
+ * REFERENCES
+ *
+ * Best, D. J. and D. E. Roberts (1975).
+ * Percentage Points of the Chi-Squared Disribution.
+ * Applied Statistics 24, page 385.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static private double C7 = 4.67;
+ static private double C8 = 6.66;
+ static private double C9 = 6.73;
+ static private double C10 = 13.32;
+
+ static private double C11 = 60;
+ static private double C12 = 70;
+ static private double C13 = 84;
+ static private double C14 = 105;
+ static private double C15 = 120;
+ static private double C16 = 127;
+ static private double C17 = 140;
+ static private double C18 = 1175;
+ static private double C19 = 210;
+
+ static private double C20 = 252;
+ static private double C21 = 2264;
+ static private double C22 = 294;
+ static private double C23 = 346;
+ static private double C24 = 420;
+ static private double C25 = 462;
+ static private double C26 = 606;
+ static private double C27 = 672;
+ static private double C28 = 707;
+ static private double C29 = 735;
+
+ static private double C30 = 889;
+ static private double C31 = 932;
+ static private double C32 = 966;
+ static private double C33 = 1141;
+ static private double C34 = 1182;
+ static private double C35 = 1278;
+ static private double C36 = 1740;
+ static private double C37 = 2520;
+ static private double C38 = 5040;
+
+ static private double EPS0 = 5e-7/* originally: IDENTICAL to EPS2; not clear why */;
+ static private double EPS1 = 1e-2;
+ static private double EPS2 = 5e-7;
+ static private double MAXIT = 20;
+
+ static private double pMIN = 0.000002;
+ static private double pMAX = 0.999998;
+
+ public static double quantile(double p, double alpha, double scale)
+ {
+ double a, b, c, ch, g, p1, v;
+ double p2, q, s1, s2, s3, s4, s5, s6, t=0.0, x;
+ int i;
+
+ /* test arguments and initialise */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(p) || Double.isNaN(alpha) || Double.isNaN(scale))
+ return p + alpha + scale;
+ /*!* #endif /*4!*/
+
+ if (p < 0 || p > 1 || alpha <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (/* 0 <= */ p < pMIN) return 0;
+ if (/* 1 >= */ p > pMAX) return Double.POSITIVE_INFINITY;
+
+ v = 2*alpha;
+
+ c = alpha-1;
+/*!* g = lgammafn(alpha);!!!COMMENT!!! *!*/
+ g = Misc.lgammafn(alpha);/* log Gamma(v/2) */
+
+/*!* if(v < (-1.24)*log(p)) { *!*/
+ if(v < (-1.24)*java.lang.Math.log(p)) {
+ /* starting approximation for small chi-squared */
+
+/*!* ch = pow(p*alpha*exp(g+alpha*Constants.M_LN_2), 1/alpha); *!*/
+ ch = java.lang.Math.pow(p*alpha*java.lang.Math.exp(g+alpha*Constants.M_LN_2), 1/alpha);
+ if(ch < EPS0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+
+ } else if(v > 0.32) {
+
+ /* starting approximation using Wilson and Hilferty estimate */
+
+ x = Normal.quantile(p, 0, 1);
+ p1 = 0.222222/v;
+/*!* ch = v*pow(x*sqrt(p1)+1-p1, 3); *!*/
+ ch = v*java.lang.Math.pow(x*java.lang.Math.sqrt(p1)+1-p1, 3);
+
+ /* starting approximation for p tending to 1 */
+
+ if( ch > 2.2*v + 6 )
+/*!* ch = -2*(log(1-p) - c*log(0.5*ch) + g); *!*/
+ ch = -2*(java.lang.Math.log(1-p) - c*java.lang.Math.log(0.5*ch) + g);
+
+ } else { /* starting approximation for v <= 0.32 */
+
+ ch = 0.4;
+/*!* a = log(1-p) + g + c*Constants.M_LN_2; *!*/
+ a = java.lang.Math.log(1-p) + g + c*Constants.M_LN_2;
+ do {
+ q = ch;
+ p1 = 1+ch*(C7+ch);
+ p2 = ch*(C9+ch*(C8+ch));
+ t = -0.5 +(C7+2*ch)/p1 - (C9+ch*(C10+3*ch))/p2;
+/*!* ch -= (1- exp(a+0.5*ch)*p2/p1)/t; *!*/
+ ch -= (1- java.lang.Math.exp(a+0.5*ch)*p2/p1)/t;
+/*!* } while(fabs(q/ch - 1) > EPS1); *!*/
+ } while(java.lang.Math.abs(q/ch - 1) > EPS1);
+ }
+
+ /* algorithm AS 239 and calculation of seven term taylor series */
+
+ for( i=1 ; i <= MAXIT ; i++ ) {
+ q = ch;
+ p1 = 0.5*ch;
+ p2 = p - cumulative(p1, alpha, 1);
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(p2))
+ /*!* #else /*4!*/
+ // if((!!!!fixme!!!!) != 0)
+ /*!* #endif /*4!*/
+ // return Double.NaN;
+
+/*!* t = p2*exp(alpha*Constants.M_LN_2+g+p1-c*log(ch)); *!*/
+ t = p2*java.lang.Math.exp(alpha*Constants.M_LN_2+g+p1-c*java.lang.Math.log(ch));
+ b = t/ch;
+ a = 0.5*t-b*c;
+ s1 = (C19+a*(C17+a*(C14+a*(C13+a*(C12+C11*a)))))/C24;
+ s2 = (C24+a*(C29+a*(C32+a*(C33+C35*a))))/C37;
+ s3 = (C19+a*(C25+a*(C28+C31*a)))/C37;
+ s4 = (C20+a*(C27+C34*a)+c*(C22+a*(C30+C36*a)))/C38;
+ s5 = (C13+C21*a+c*(C18+C26*a))/C37;
+ s6 = (C15+c*(C23+C16*c))/C38;
+ ch = ch+t*(1+0.5*t*s1-b*c*(s1-b*(s2-b*(s3-b*(s4-b*(s5-b*s6))))));
+/*!* if(fabs(q/ch-1) > EPS2) *!*/
+ if(java.lang.Math.abs(q/ch-1) > EPS2)
+ return 0.5*scale*ch;
+ }
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ // return 0.5*scale*ch;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double a, double scale);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Gamma distribution.
+ *
+ * REFERENCES
+ *
+ * [1] Shape parameter a >= 1. Algorithm GD in:
+ *
+ * Ahrens, J.H. and Dieter, U. (1982).
+ * Generating Gamma variates by a modified
+ * rejection technique.
+ * Comm. ACM, 25, 47-54.
+ *
+ *
+ * [2] Shape parameter 0 < a < 1. Algorithm GS in:
+ *
+ * Ahrens, J.H. and Dieter, U. (1974).
+ * Computer methods for sampling from Gamma, beta,
+ * poisson and binomial distributions.
+ * Computing, 12, 223-246.
+ *
+ * Input: a = parameter (mean) of the standard Gamma distribution.
+ * Output: a variate from the Gamma(a)-distribution
+ *
+ * Coefficients q(k) - for q0 = sum(q(k)*a**(-k))
+ * Coefficients a(k) - for q = q0+(t*t/2)*sum(a(k)*v**k)
+ * Coefficients e(k) - for exp(q)-1 = sum(e(k)*q**k)
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static private double a1 = 0.3333333;
+ static private double a2 = -0.250003;
+ static private double a3 = 0.2000062;
+ static private double a4 = -0.1662921;
+ static private double a5 = 0.1423657;
+ static private double a6 = -0.1367177;
+ static private double a7 = 0.1233795;
+ static private double e1 = 1.0;
+ static private double e2 = 0.4999897;
+ static private double e3 = 0.166829;
+ static private double e4 = 0.0407753;
+ static private double e5 = 0.010293;
+ static private double q1 = 0.04166669;
+ static private double q2 = 0.02083148;
+ static private double q3 = 0.00801191;
+ static private double q4 = 0.00144121;
+ static private double q5 = -7.388e-5;
+ static private double q6 = 2.4511e-4;
+ static private double q7 = 2.424e-4;
+ static private double sqrt32 = 5.656854;
+
+ static private double aa = 0.;
+ static private double aaa = 0.;
+
+ static private double b, c, d, e, p, q, r, s, t, u, v, w, x;
+ static private double q0, s2, si;
+
+
+ public static double random(double a, double scale, Uniform uniformDistribution)
+ {
+ double ret_val;
+
+ if (a < 1.0) {
+ /* alternate method for parameters a below 1 */
+ /* 0.36787944117144232159 = exp(-1) */
+ aa = 0.0;
+ b = 1.0 + 0.36787944117144232159 * a;
+ while(true) {
+ p = b * uniformDistribution.random();
+ if (p >= 1.0) {
+/*!* ret_val = -log((b - p) / a); *!*/
+ ret_val = -java.lang.Math.log((b - p) / a);
+/*!* if (Exponential.random!!!COMMENT!!!() >= (1.0 - a) * log(ret_val)) *!*/
+ if (Exponential.random(uniformDistribution) >= (1.0 - a) * java.lang.Math.log(ret_val))
+ break;
+ } else {
+/*!* ret_val = exp(log(p) / a); *!*/
+ ret_val = java.lang.Math.exp(java.lang.Math.log(p) / a);
+ if (Exponential.random(uniformDistribution) >= ret_val)
+ break;
+ }
+ }
+ return scale * ret_val;
+ }
+ /* Step 1: Recalculations of s2, s, d if a has changed */
+ if (a != aa) {
+ aa = a;
+ s2 = a - 0.5;
+/*!* s = sqrt(s2); *!*/
+ s = java.lang.Math.sqrt(s2);
+ d = sqrt32 - s * 12.0;
+ }
+ /* Step 2: t = standard Normal deviate, */
+ /* x = (s,1/2)-Normal deviate. */
+ /* immediate acceptance (i) */
+
+ t = Normal.random(uniformDistribution);
+ x = s + 0.5 * t;
+ ret_val = x * x;
+ if (t >= 0.0)
+ return scale * ret_val;
+
+ /* Step 3: u = 0,1 - Uniform sample. squeeze acceptance (s) */
+ u = uniformDistribution.random();
+ if (d * u <= t * t * t) {
+ return scale * ret_val;
+ }
+ /* Step 4: recalculations of q0, b, si, c if necessary */
+
+ if (a != aaa) {
+ aaa = a;
+ r = 1.0 / a;
+ q0 = ((((((q7 * r + q6) * r + q5) * r + q4)
+ * r + q3) * r + q2) * r + q1) * r;
+
+ /* Approximation depending on size of parameter a */
+ /* The constants in the expressions for b, si and */
+ /* c were established by numerical experiments */
+
+ if (a <= 3.686) {
+ b = 0.463 + s + 0.178 * s2;
+ si = 1.235;
+ c = 0.195 / s - 0.079 + 0.16 * s;
+ } else if (a <= 13.022) {
+ b = 1.654 + 0.0076 * s2;
+ si = 1.68 / s + 0.275;
+ c = 0.062 / s + 0.024;
+ } else {
+ b = 1.77;
+ si = 0.75;
+ c = 0.1515 / s;
+ }
+ }
+ /* Step 5: no quotient test if x not positive */
+
+ if (x > 0.0) {
+ /* Step 6: calculation of v and quotient q */
+ v = t / (s + s);
+/*!* if (fabs(v) <= 0.25) *!*/
+ if (java.lang.Math.abs(v) <= 0.25)
+ q = q0 + 0.5 * t * t * ((((((a7 * v + a6)
+ * v + a5) * v + a4) * v + a3)
+ * v + a2) * v + a1) * v;
+ else
+ q = q0 - s * t + 0.25 * t * t + (s2 + s2)
+/*!* * log(1.0 + v); *!*/
+ * java.lang.Math.log(1.0 + v);
+
+
+ /* Step 7: quotient acceptance (q) */
+
+/*!* if (log(1.0 - u) <= q) *!*/
+ if (java.lang.Math.log(1.0 - u) <= q)
+ return scale * ret_val;
+ }
+ /* Step 8: e = standard Exponential deviate */
+ /* u= 0,1 -Uniform deviate */
+ /* t=(b,si)-double Exponential (laplace) sample */
+
+ while(true) {
+ e = Exponential.random(uniformDistribution);
+ u = uniformDistribution.random();
+ u = u + u - 1.0;
+ if (u < 0.0)
+ t = b - si * e;
+ else
+ t = b + si * e;
+ /* Step 9: rejection if t < tau(1) = -0.71874483771719 */
+ if (t >= -0.71874483771719) {
+ /* Step 10: calculation of v and quotient q */
+ v = t / (s + s);
+/*!* if (fabs(v) <= 0.25) *!*/
+ if (java.lang.Math.abs(v) <= 0.25)
+ q = q0 + 0.5 * t * t * ((((((a7 * v + a6)
+ * v + a5) * v + a4) * v + a3)
+ * v + a2) * v + a1) * v;
+ else
+ q = q0 - s * t + 0.25 * t * t + (s2 + s2)
+/*!* * log(1.0 + v); *!*/
+ * java.lang.Math.log(1.0 + v);
+ /* Step 11: hat acceptance (h) */
+ /* (if q not positive go to step 8) */
+ if (q > 0.0) {
+ if (q <= 0.5)
+ w = ((((e5 * q + e4) * q + e3)
+ * q + e2) * q + e1) * q;
+ else
+/*!* w = exp(q) - 1.0; *!*/
+ w = java.lang.Math.exp(q) - 1.0;
+ /* if t is rejected */
+ /* sample again at step 8 */
+/*!* if (c * fabs(u) <= w * exp(e - 0.5 * t * t)) *!*/
+ if (c * java.lang.Math.abs(u) <= w * java.lang.Math.exp(e - 0.5 * t * t))
+ break;
+ }
+ }
+ }
+ x = s + 0.5 * t;
+ return scale * x * x;
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Geometric.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Geometric.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Geometric.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Geometric.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,215 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Geometric
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double p);
+ *
+ * DESCRIPTION
+ *
+ * The density of the Geometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(p)) return x + p;
+ /*!* #endif /*4!*/
+ if (p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if (x < 0)
+ return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x)) return 1;
+ /*!* #endif /*4!*/
+/*!* return p * pow(1 - p, x); *!*/
+ return p * java.lang.Math.pow(1 - p, x);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double p);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Geometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(p))
+ return x + p;
+ /*!* #endif /*4!*/
+/*!* x = floor(x); *!*/
+ x = java.lang.Math.floor(x);
+ if(p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0.0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(x)) return 1;
+ /*!* #endif /*4!*/
+/*!* return 1 - pow(1 - p, x + 1); *!*/
+ return 1 - java.lang.Math.pow(1 - p, x + 1);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double p);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Geometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(p))
+ return x + p;
+ if (x < 0 || x > 1 || p <= 0 || p > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 1) return Double.POSITIVE_INFINITY;
+ /*!* #else /*4!*/
+ if (x < 0 || x >= 1 || p <= 0 || p > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+ if (x == 0) return 0;
+/*!* return ceil(log(1 - x) / log(1.0 - p) - 1); *!*/
+ return java.lang.Math.ceil(java.lang.Math.log(1 - x) / java.lang.Math.log(1.0 - p) - 1);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka and the R Core Team.
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double p);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Geometric distribution.
+ *
+ * NOTES
+ *
+ * We generate lambda as Exponential with scale parameter
+ * p / (1 - p). Return a Poisson deviate with mean lambda.
+ *
+ * REFERENCE
+ *
+ * Devroye, L. (1980).
+ * Non-Uniform Random Variate Generation.
+ * New York: Springer-Verlag.
+ * Page 480.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double p, Uniform uniformDistribution)
+ {
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isNaN(p) ||
+ /*!* #endif /*4!*/
+ p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ return Poisson.random(Exponential.random( uniformDistribution ) * ((1 - p) / p), uniformDistribution);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Hypergeometric.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Hypergeometric.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Hypergeometric.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Hypergeometric.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,603 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Hypergeometric
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double NR, double NB, double n);
+ *
+ * DESCRIPTION
+ *
+ * The density of the Hypergeometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double NR, double NB, double n)
+ {
+ double N;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(NR) || Double.isNaN(NB) || Double.isNaN(n))
+ return x + NR + NB + n;
+ /*!* #endif /*4!*/
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+/*!* NR = floor(NR + 0.5); *!*/
+ NR = java.lang.Math.floor(NR + 0.5);
+/*!* NB = floor(NB + 0.5); *!*/
+ NB = java.lang.Math.floor(NB + 0.5);
+ N = NR + NB;
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (NR < 0 || NB < 0 || n < 0 || n > N) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* if (x < fmax2(0, n - NB) || x > fmin2(n, NR)) *!*/
+ if (x < Math.max(0, n - NB) || x > Math.min(n, NR))
+ return 0;
+/*!* return exp(lfastchoose(NR, x) + lfastchoose(NB, n - x) *!*/
+ return java.lang.Math.exp(Misc.lfastchoose(NR, x) + Misc.lfastchoose(NB, n - x)
+/*!* - lfastchoose(N, n)); *!*/
+ - Misc.lfastchoose(N, n));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double NR, double NB, double n);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Hypergeometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double NR, double NB, double n)
+ {
+ double N, xstart, xend, xr, xb, sum, term;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(x) || Double.isNaN(NR) || Double.isNaN(NB) || Double.isNaN(n))
+ return x + NR + NB + n;
+ if(Double.isInfinite(x) || Double.isInfinite(NR) || Double.isInfinite(NB) || Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+/*!* x = floor(x); *!*/
+ x = java.lang.Math.floor(x);
+/*!* NR = floor(NR + 0.5); *!*/
+ NR = java.lang.Math.floor(NR + 0.5);
+/*!* NB = floor(NB + 0.5); *!*/
+ NB = java.lang.Math.floor(NB + 0.5);
+ N = NR + NB;
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (NR < 0 || NB < 0 || n < 0 || n > N) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* xstart = fmax2(0, n - NB); *!*/
+ xstart = Math.max(0, n - NB);
+/*!* xend = fmin2(n, NR); *!*/
+ xend = Math.min(n, NR);
+ if(x < xstart) return 0.0;
+ if(x >= xend) return 1.0;
+ xr = xstart;
+ xb = n - xr;
+/*!* term = exp(lfastchoose(NR, xr) + lfastchoose(NB, xb) *!*/
+ term = java.lang.Math.exp(Misc.lfastchoose(NR, xr) + Misc.lfastchoose(NB, xb)
+/*!* - lfastchoose(N, n)); *!*/
+ - Misc.lfastchoose(N, n));
+ NR = NR - xr;
+ NB = NB - xb;
+ sum = 0.0;
+ while(xr <= x) {
+ sum += term;
+ xr++;
+ NB++;
+ term *= (NR / xr) * (xb / NB);
+ xb--;
+ NR--;
+ }
+ return sum;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double NR, double NB, double n);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Hypergeometric distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double NR, double NB, double n)
+ {
+ double N, xstart, xend, xr, xb, sum, term;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(NR) || Double.isNaN(NB) || Double.isNaN(n))
+ return x + NR + NB + n;
+ if(Double.isInfinite(x) || Double.isInfinite(NR) || Double.isInfinite(NB) || Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* NR = floor(NR + 0.5); *!*/
+ NR = java.lang.Math.floor(NR + 0.5);
+/*!* NB = floor(NB + 0.5); *!*/
+ NB = java.lang.Math.floor(NB + 0.5);
+ N = NR + NB;
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (x < 0 || x > 1 || NR < 0 || NR < 0 || n < 0 || n > N) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* xstart = fmax2(0, n - NB); *!*/
+ xstart = Math.max(0, n - NB);
+/*!* xend = fmin2(n, NR); *!*/
+ xend = Math.min(n, NR);
+ if(x <= 0) return xstart;
+ if(x >= 1) return xend;
+ xr = xstart;
+ xb = n - xr;
+/*!* term = exp(lfastchoose(NR, xr) + lfastchoose(NB, xb) *!*/
+ term = java.lang.Math.exp(Misc.lfastchoose(NR, xr) + Misc.lfastchoose(NB, xb)
+/*!* - lfastchoose(N, n)); *!*/
+ - Misc.lfastchoose(N, n));
+ NR = NR - xr;
+ NB = NB - xb;
+ sum = term;
+ while(sum < x && xr < xend) {
+ xr++;
+ NB++;
+ term *= (NR / xr) * (xb / NB);
+ sum += term;
+ xb--;
+ NR--;
+ }
+ return xr;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double NR, double NB, double n);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Hypergeometric distribution.
+ * Returns the number of white balls drawn when kk balls
+ * are drawn at random from an urn containing nn1 white
+ * and nn2 black balls.
+ *
+ * REFERENCE
+ *
+ * V. Kachitvichyanukul and B. Schmeiser (1985).
+ * ``Computer generation of Hypergeometric random variates,''
+ * Journal of Statistical Computation and Simulation 22, 127-145.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ /* afc(i) := ln( i! ) [logarithm of the factorial i.
+ * If (i > 7), use Stirling's approximation, otherwise use table lookup.
+ */
+
+ static private double al[] =
+ {
+ 0.0,
+ 0.0,/*ln(0!)=ln(1)*/
+ 0.0,/*ln(1!)=ln(1)*/
+ 0.69314718055994530941723212145817,/*ln(2) */
+ 1.79175946922805500081247735838070,/*ln(6) */
+ 3.17805383034794561964694160129705,/*ln(24)*/
+ 4.78749174278204599424770093452324,
+ 6.57925121201010099506017829290394,
+ 8.52516136106541430016553103634712
+ /*, 10.60460290274525022841722740072165*/
+ };
+
+ static private double afc(int i)
+ {
+ double di, value;
+ if (i < 0) {
+ System.out.println("rhyper.c: afc(i)+ i=%d < 0 -- SHOULD NOT HAPPEN!\n"+i);
+ return -1;/* unreached (Wall) */
+ } else if (i <= 7) {
+ value = al[i + 1];
+ } else {
+ di = i;
+/*!* value = (di + 0.5) * log(di) - di + 0.08333333333333 / di *!*/
+ value = (di + 0.5) * java.lang.Math.log(di) - di + 0.08333333333333 / di
+ - 0.00277777777777 / di / di / di + 0.9189385332;
+ }
+ return value;
+ }
+
+
+ static private int ks = -1;
+ static private int n1s = -1;
+ static private int n2s = -1;
+ static private double con = 57.56462733;
+ static private double deltal = 0.0078;
+ static private double deltau = 0.0034;
+ static private double scale = 1e25;
+
+ static private double a;
+ static private double d, e, f, g;
+ static private int i, k, m;
+ static private double p;
+ static private double r, s, t;
+ static private double u, v, w;
+ static private double lamdl, y, lamdr;
+ static private int minjx, maxjx, n1, n2;
+ static private double p1, p2, p3, y1, de, dg;
+ static private boolean setup1, setup2;
+ static private double gl, kl, ub, nk, dr, nm, gu, kr, ds, dt;
+ static private int ix;
+ static private double tn;
+ static private double xl;
+ static private double ym, yn, yk, xm;
+ static private double xr;
+ static private double xn;
+ static private boolean reject;
+ static private double xk;
+ /* extern double afc(int); */
+ static private double alv;
+
+
+ public static double random(double nn1in, double nn2in, double kkin,
+ Uniform uniformDistribution)
+ {
+ int nn1, nn2, kk;
+
+ /* check parameter validity */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(nn1in) || Double.isInfinite(nn2in) || Double.isInfinite(kkin)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+/*!* nn1 = floor(nn1in+0.5); *!*/
+ nn1 = (int) java.lang.Math.floor(nn1in+0.5);
+/*!* nn2 = floor(nn2in+0.5); *!*/
+ nn2 = (int) java.lang.Math.floor(nn2in+0.5);
+/*!* kk = floor(kkin+0.5); *!*/
+ kk = (int) java.lang.Math.floor(kkin+0.5);
+
+ if (nn1 < 0 || nn2 < 0 || kk < 0 || kk > nn1 + nn2) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /* if new parameter values, initialize */
+
+ reject = true;
+ setup1 = false;
+ setup2 = false;
+ if (nn1 != n1s || nn2 != n2s) {
+ setup1 = true;
+ setup2 = true;
+ } else if (kk != ks) {
+ setup2 = true;
+ }
+ if (setup1) {
+ n1s = nn1;
+ n2s = nn2;
+ tn = nn1 + nn2;
+ if (nn1 <= nn2) {
+ n1 = nn1;
+ n2 = nn2;
+ } else {
+ n1 = nn2;
+ n2 = nn1;
+ }
+ }
+ if (setup2) {
+ ks = kk;
+ if (kk + kk >= tn) {
+ k = (int) (tn) - kk;
+ } else {
+ k = kk;
+ }
+ }
+ if (setup1 || setup2) {
+ m = (int) ((k + 1.0) * (n1 + 1.0) / (tn + 2.0));
+/*!* minjx = imax2(0, k - n2); *!*/
+ minjx = Math.max(0, k - n2);
+/*!* maxjx = Math.min(n1, k); *!*/
+ maxjx = Math.min(n1, k);
+ }
+ /* generate random variate */
+
+ if (minjx == maxjx) {
+ /* degenerate distribution */
+ ix = maxjx;
+ /* return ix;
+ No, need to unmangle */
+ /* return appropriate variate */
+
+ if (kk + kk >= tn) {
+ if (nn1 > nn2) {
+ ix = kk - nn2 + ix;
+ } else {
+ ix = nn1 - ix;
+ }
+ } else {
+ if (nn1 > nn2)
+ ix = kk - ix;
+ }
+ return ix;
+
+ } else if (m - minjx < 10) {
+ /* inverse transformation */
+ if (setup1 || setup2) {
+ if (k < n2) {
+ /*!* w = exp(con + afc(n2) + afc(n1 + n2 - k) *!*/
+ w = java.lang.Math.exp(con + afc(n2) + afc(n1 + n2 - k)
+ - afc(n2 - k) - afc(n1 + n2));
+ } else {
+ /*!* w = exp(con + afc(n1) + afc(k) *!*/
+ w = java.lang.Math.exp(con + afc(n1) + afc(k)
+ - afc(k - n2) - afc(n1 + n2));
+ }
+ }
+ L10: while(true) {
+ p = w;
+ ix = minjx;
+ u = uniformDistribution.random() * scale;
+ L20: while(true) {
+ if (u > p) {
+ u = u - p;
+ p = p * (n1 - ix) * (k - ix);
+ ix = ix + 1;
+ p = p / ix / (n2 - k + ix);
+ if (ix > maxjx)
+ continue L10;
+ continue L20;
+ }
+ break L10;
+ }}
+ } else {
+ /* h2pe */
+
+ if (setup1 || setup2) {
+ /*!* s = sqrt((tn - k) * k * n1 * n2 / (tn - 1) / tn / tn); *!*/
+ s = java.lang.Math.sqrt((tn - k) * k * n1 * n2 / (tn - 1) / tn / tn);
+
+ /* remark: d is defined in reference without int. */
+ /* the truncation centers the cell boundaries at 0.5 */
+
+ d = (int) (1.5 * s) + .5;
+ xl = m - d + .5;
+ xr = m + d + .5;
+ a = afc(m) + afc(n1 - m) + afc(k - m)
+ + afc(n2 - k + m);
+/*!* kl = exp(a - afc((int) (xl)) - afc((int) (n1 - xl)) *!*/
+ kl = java.lang.Math.exp(a - afc((int) (xl)) - afc((int) (n1 - xl))
+ - afc((int) (k - xl))
+ - afc((int) (n2 - k + xl)));
+/*!* kr = exp(a - afc((int) (xr - 1)) *!*/
+ kr = java.lang.Math.exp(a - afc((int) (xr - 1))
+ - afc((int) (n1 - xr + 1))
+ - afc((int) (k - xr + 1))
+ - afc((int) (n2 - k + xr - 1)));
+/*!* lamdl = -log(xl * (n2 - k + xl) / (n1 - xl + 1) *!*/
+ lamdl = -java.lang.Math.log(xl * (n2 - k + xl) / (n1 - xl + 1)
+ / (k - xl + 1));
+/*!* lamdr = -log((n1 - xr + 1) * (k - xr + 1) *!*/
+ lamdr = -java.lang.Math.log((n1 - xr + 1) * (k - xr + 1)
+ / xr / (n2 - k + xr));
+ p1 = d + d;
+ p2 = p1 + kl / lamdl;
+ p3 = p2 + kr / lamdr;
+ }
+ L30: while(true) {
+ u = uniformDistribution.random() * p3;
+ v = uniformDistribution.random();
+ if (u < p1) {
+ /* rectangular region */
+ ix = (int) (xl + u);
+ } else if (u <= p2) {
+ /* left tail */
+/*!* ix = xl + log(v) / lamdl; *!*/
+ ix = (int) (xl + java.lang.Math.log(v) / lamdl);
+ if (ix < minjx)
+ continue L30;
+ v = v * (u - p1) * lamdl;
+ } else {
+ /* right tail */
+/*!* ix = xr - log(v) / lamdr; *!*/
+ ix = (int) (xr - java.lang.Math.log(v) / lamdr);
+ if (ix > maxjx)
+ continue L30;
+ v = v * (u - p2) * lamdr;
+ }
+
+ /* acceptance/rejection test */
+
+ if (m < 100 || ix <= 50) {
+ /* explicit evaluation */
+ f = 1.0;
+ if (m < ix) {
+ for (i = m + 1; i <= ix; i++)
+ f = f * (n1 - i + 1) * (k - i + 1)
+ / (n2 - k + i) / i;
+ } else if (m > ix) {
+ for (i = ix + 1; i <= m; i++)
+ f = f * i * (n2 - k + i) / (n1 - i)
+ / (k - i);
+ }
+ if (v <= f) {
+ reject = false;
+ }
+ } else {
+ /* squeeze using upper and lower bounds */
+ y = ix;
+ y1 = y + 1.0;
+ ym = y - m;
+ yn = n1 - y + 1.0;
+ yk = k - y + 1.0;
+ nk = n2 - k + y1;
+ r = -ym / y1;
+ s = ym / yn;
+ t = ym / yk;
+ e = -ym / nk;
+ g = yn * yk / (y1 * nk) - 1.0;
+ dg = 1.0;
+ if (g < 0.0)
+ dg = 1.0 + g;
+ gu = g * (1.0 + g * (-0.5 + g / 3.0));
+ gl = gu - .25 * (g * g * g * g) / dg;
+ xm = m + 0.5;
+ xn = n1 - m + 0.5;
+ xk = k - m + 0.5;
+ nm = n2 - k + xm;
+ ub = y * gu - m * gl + deltau
+ + xm * r * (1. + r * (-0.5 + r / 3.0))
+ + xn * s * (1. + s * (-0.5 + s / 3.0))
+ + xk * t * (1. + t * (-0.5 + t / 3.0))
+ + nm * e * (1. + e * (-0.5 + e / 3.0));
+ /* test against upper bound */
+/*!* alv = log(v); *!*/
+ alv = java.lang.Math.log(v);
+ if (alv > ub) {
+ reject = true;
+ } else {
+ /* test against lower bound */
+ dr = xm * (r * r * r * r);
+ if (r < 0.0)
+ dr = dr / (1.0 + r);
+ ds = xn * (s * s * s * s);
+ if (s < 0.0)
+ ds = ds / (1.0 + s);
+ dt = xk * (t * t * t * t);
+ if (t < 0.0)
+ dt = dt / (1.0 + t);
+ de = nm * (e * e * e * e);
+ if (e < 0.0)
+ de = de / (1.0 + e);
+ if (alv < ub - 0.25 * (dr + ds + dt + de)
+ + (y + m) * (gl - gu) - deltal) {
+ reject = false;
+ } else {
+ /*
+ * stirling's formula to machine
+ * accuracy
+ */
+ if (alv <= (a - afc(ix) - afc(n1 - ix)
+ - afc(k - ix) - afc(n2 - k + ix))) {
+ reject = false;
+ } else {
+ reject = true;
+ }
+ }
+ }
+ }
+ if (reject)
+ continue L30;
+ break L30;
+ }
+ }
+ /* return appropriate variate */
+
+ if (kk + kk >= tn) {
+ if (nn1 > nn2) {
+ ix = kk - nn2 + ix;
+ } else {
+ ix = nn1 - ix;
+ }
+ } else {
+ if (nn1 > nn2)
+ ix = kk - ix;
+ }
+ return ix;
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Logistic.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Logistic.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Logistic.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Logistic.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,158 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Logistic
+ {
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double location, double scale)
+ {
+ double e, f;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ /*!* #endif /*4!*/
+ if (scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* e = exp(-(x - location) / scale); *!*/
+ e = java.lang.Math.exp(-(x - location) / scale);
+ f = 1.0 + e;
+ return e / (scale * f * f);
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double location, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ /*!* #endif /*4!*/
+ if (scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if(Double.isInfinite(x)) {
+ if (x > 0) return 1;
+ else return 0;
+ }
+/*!* return 1.0 / (1.0 + exp(-(x - location) / scale)); *!*/
+ return 1.0 / (1.0 + java.lang.Math.exp(-(x - location) / scale));
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double location, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(location) || Double.isNaN(scale))
+ return x + location + scale;
+ /*!* #endif /*4!*/
+ if (scale <= 0.0 || x < 0 || x > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if(x <= 0) return Double.NEGATIVE_INFINITY;
+ if(x == 1) return Double.POSITIVE_INFINITY;
+/*!* return location + scale * log(x / (1.0 - x)); *!*/
+ return location + scale * java.lang.Math.log(x / (1.0 - x));
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double location, double scale, Uniform uniformDistribution)
+ {
+ double u;
+ /* #ifndef IEEE_754 */
+ if (Double.isInfinite(location) || Double.isInfinite(scale)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /* #endif */
+ u = uniformDistribution.random();
+/*!* return location + scale * log(u / (1.0 - u)); *!*/
+ return location + scale * java.lang.Math.log(u / (1.0 - u));
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/LogNormal.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/LogNormal.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/LogNormal.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/LogNormal.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,195 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class LogNormal
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * double density(double x, double logmean, double logsd);
+ *
+ * DESCRIPTION
+ *
+ * The density of the LogNormal distribution.
+ *
+ * M_1_SQRT_2PI = 1 / sqrt(2 * pi)
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double logmean, double logsd)
+ {
+ double y;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(logmean) || Double.isNaN(logsd))
+ return x + logmean + logsd;
+ /*!* #endif /*4!*/
+ if(logsd <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if(x == 0) return 0;
+/*!* y = (log(x) - logmean) / logsd; *!*/
+ y = (java.lang.Math.log(x) - logmean) / logsd;
+/*!* return Constants.M_1_SQRT_2PI * exp(-0.5 * y * y) / (x * logsd); *!*/
+ return Constants.M_1_SQRT_2PI * java.lang.Math.exp(-0.5 * y * y) / (x * logsd);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double logmean, double logsd);
+ *
+ * DESCRIPTION
+ *
+ * The LogNormal distribution function.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double logmean, double logsd)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(logmean) || Double.isNaN(logsd))
+ return x + logmean + logsd;
+ /*!* #endif /*4!*/
+ if (logsd <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x > 0)
+/*!* return Normal.cumulative!!!COMMENT!!!(log(x), logmean, logsd); *!*/
+ return Normal.cumulative(java.lang.Math.log(x), logmean, logsd);
+ return 0;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double logmean, double logsd);
+ *
+ * DESCRIPTION
+ *
+ * This the LogNormal quantile function.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double logmean, double logsd)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(logmean) || Double.isNaN(logsd))
+ return x + logmean + logsd;
+ /*!* #endif /*4!*/
+ if(x < 0 || x > 1 || logsd <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 1) return Double.POSITIVE_INFINITY;
+/*!* if (x > 0) return exp(qnorm(x, logmean, logsd)); *!*/
+ if (x > 0) return java.lang.Math.exp(Normal.quantile(x, logmean, logsd));
+ return 0;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double logmean, double logsd);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the LogNormal distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double logmean, double logsd, Uniform uniformDistribution)
+ {
+ if(
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(logmean) || Double.isInfinite(logsd) ||
+ /*!* #endif /*4!*/
+ logsd <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* return exp(rnorm(logmean, logsd)); *!*/
+ return java.lang.Math.exp(Normal.random(logmean, logsd, uniformDistribution));
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Misc.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Misc.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Misc.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Misc.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,1441 @@
+/* DistLib - A Mathematical Function Library
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+package org.mathpiper.builtin.library.statdistlib;
+
+/**
+ * Miscellaneous functions and values.
+ */
+
+public class Misc {
+
+ /**
+ * Value of the beta function
+ * evaluated with arguments a and b.
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ * Some modifications have been made so that the routines
+ * conform to the IEEE 754 standard.
+ */
+
+ public static double beta(double a, double b) {
+ double xmax = 0;
+ double alnsml = 0;
+ double val=0.0, xmin=0.0;
+ double temp[];
+
+ if (xmax == 0) {
+ temp = gammalims(xmin, xmax);
+ xmin = temp[0]; xmax=temp[1];
+ alnsml = java.lang.Math.log(d1mach(1));
+ }
+
+ if (Double.isNaN(a) || Double.isNaN(b)) return a + b;
+
+ if (a < 0 || b < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ else if (a == 0 || b == 0) {
+ return Double.POSITIVE_INFINITY;
+ }
+ else if (Double.isInfinite(a) || Double.isInfinite(b)) {
+ return 0;
+ }
+
+ if (a + b < xmax)
+ return gammafn(a) * gammafn(b) / gammafn(a+b);
+
+ val = lbeta(a, b);
+ // check for underflow of beta
+ if (val < alnsml) {
+ throw new java.lang.ArithmeticException("Math Error: UNDERFLOW");
+ }
+ return java.lang.Math.exp(val);
+ }
+
+ /**
+ * Determine the number of terms for the
+ * double precision orthogonal Chebyshev series "dos" needed to insure
+ * the error is no larger than "eta". Ordinarily eta will be
+ * chosen to be one-tenth machine precision.
+ *
+ * These routines are translations into C of Fortran routines
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ *
+ * Based on the Fortran routine dcsevl by W. Fullerton.
+ * Adapted from R. Broucke, Algorithm 446, CACM., 16, 254 (1973).
+ */
+ static int chebyshev_init(double dos[], int nos, double eta) {
+ if (nos < 1) return 0;
+
+ double err = 0.0;
+ int i = 0;
+ for (int ii=1; ii<=nos; ii++) {
+ i = nos - ii;
+ err += java.lang.Math.abs(dos[i]);
+ if (err > eta) {
+ return i;
+ }
+ }
+ return i;
+ }
+
+ /**
+ * evaluate the n-term Chebyshev series
+ * @param x
+ * @param a
+ * @param n
+ * @return
+ */
+ public static double chebyshev_eval(double x, double a[], int n) {
+ if (n < 1 || n > 1000) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ if (x < -1.1 || x > 1.1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ double twox = x * 2;
+ double b2 = 0;
+ double b1 = 0;
+ double b0 = 0;
+ for (int i = 1; i <= n; i++) {
+ b2 = b1;
+ b1 = b0;
+ b0 = twox * b1 - b2 + a[(int) n - i];
+ }
+ return (b0 - b2) * 0.5;
+ }
+
+ /*
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double choose(double n, double k);
+ * double fastchoose(double n, double k);
+ * double lchoose(double n, double k);
+ * double lfastchoose(double n, double k);
+ *
+ * DESCRIPTION
+ *
+ * Binomial coefficients.
+ */
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double lfastchoose(double n, double k) {
+ return lgammafn(n + 1.0) - lgammafn(k + 1.0) - lgammafn(n - k + 1.0);
+ }
+
+ public static double fastchoose(double n, double k) {
+ return java.lang.Math.exp(lfastchoose(n, k));
+ }
+
+ public static double lchoose(double n, double k) {
+ n = java.lang.Math.floor(n + 0.5);
+ k = java.lang.Math.floor(k + 0.5);
+ if (Double.isNaN(n) || Double.isNaN(k)) return n + k;
+ if (k < 0 || n < k) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ return lfastchoose(n, k);
+ }
+
+ /**
+ * binomial coefficient
+ * @param n
+ * @param k
+ * @return
+ */
+ public static double choose(double n, double k) {
+ n = java.lang.Math.floor(n + 0.5);
+ k = java.lang.Math.floor(k + 0.5);
+ if (Double.isNaN(n) || Double.isNaN(k)) return n + k;
+ if (k < 0 || n < k) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ return java.lang.Math.floor(java.lang.Math.exp(lfastchoose(n, k)) + 0.5);
+ }
+
+ /**
+ * machine dependant constants
+ * @param i
+ * @return
+ */
+
+ public static double d1mach(int i) {
+ switch (i) {
+
+ case 1: return Double.MIN_VALUE;
+ case 2: return Double.MAX_VALUE;
+ case 3: return java.lang.Math.pow((double)i1mach(10), -(double)i1mach(14));
+ case 4: return java.lang.Math.pow((double)i1mach(10), 1-(double)i1mach(14));
+ case 5: return Math.log(2.0)/Math.log(10.0);
+
+ default: return 0.0;
+ }
+ }
+
+ /*
+ * Returns the cube of its argument.
+ */
+ public static double fcube(double x) {
+ return x * x * x;
+ }
+
+
+ public static double fmax2(double x, double y) {
+ if (Double.isNaN(x) || Double.isNaN(y))
+ return x + y;
+ return (x < y) ? y : x;
+ }
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double fmin2(double x, double y)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(y))
+ return x + y;
+ /*!* #endif /*4!*/
+ return (x < y) ? x : y;
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double fmod(double x, double y);
+ *
+ * DESCRIPTION
+ *
+ * Floating-point remainder of x / y;
+ *
+ * NOTES
+ *
+ * It may be better to use the system version of this function,
+ * but this version is portable.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double fmod(double x, double y)
+ {
+ double quot;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(y))
+ return x + y;
+ /*!* #endif /*4!*/
+ quot = x / y;
+/*!* return x - (quot < 0.0 ? ceil(quot) : floor(quot)) * y; *!*/
+ return x - (quot < 0.0 ? java.lang.Math.ceil(quot) : java.lang.Math.floor(quot)) * y;
+ }
+
+ /**
+ * Returns the value of x rounded to "digits" significant
+ * decimal digits.
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ * Some modifications have been made so that the routines
+ * conform to the IEEE 754 standard.
+ *
+ * Improvements by Martin Maechler, May 1997
+ * Note that the code could be further improved by using
+ * java.lang.Math.pow(x, i) instead of pow(x, (double)i)
+ */
+
+ static final double MAXPLACES = Constants.DBL_DIG;
+
+ public static double fprec(double x, double digits) {
+
+ if (Double.isNaN(x) || Double.isNaN(digits)) return x + digits;
+ if (Double.isInfinite(x)) return x;
+ if (Double.isInfinite(digits)) {
+ if (digits > 0) return x;
+ else return 0;
+ }
+
+ if (x == 0) return x;
+
+ digits = java.lang.Math.floor(digits+0.5);
+ if (digits > MAXPLACES) return x;
+ else if (digits < 1) digits = 1;
+
+ double sgn = 1.0;
+ if (x < 0.0) {
+ sgn = -sgn;
+ x = -x;
+ }
+ double l10 = Math.log(x) / Math.log(10.0);
+ // Max.expon. of 10 (=308.2547)
+ int e10 = (int)(digits-1-java.lang.Math.floor(l10));
+ final double max10e = Constants.DBL_MAX_EXP * Constants.M_LOG10_2;
+ if (Math.abs(l10) < max10e - 2) {
+ double pow10 = Math.pow(10.0, (double)e10);
+ return (sgn*Math.floor(x*pow10+0.5)/pow10);
+ } else { /* -- LARGE or small -- */
+ /*!* do_round = max10e - l10 >= pow(10.0, -digits); *!*/
+ boolean do_round = max10e - l10 >= Math.pow(10.0, -digits);
+ int e2 = (e10>0)? 16 : -16;
+ double p10 = Math.pow(10.0, (double)e2);
+ x *= p10;
+ double P10 = Math.pow(10.0, (double)e10-e2);
+ x *= P10;
+ /*-- p10 * P10 = 10 ^ e10 */
+ if (do_round) x += 0.5;
+ x = Math.floor(x) / p10;
+ return (sgn*x/P10);
+ }
+ }
+
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double fround(double x, double digits);
+ *
+ * DESCRIPTION
+ *
+ * Rounds "x" to "digits" decimal digits.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ /*!* #ifndef HAVE_RINT /*4!*/
+ /*!* #define USE_BUILTIN_RINT /*4!*/
+ /*!* #endif /*4!*/
+
+ /*!* #ifdef USE_BUILTIN_RINT /*4!*/
+ // final double R_rint = static private_rint;
+
+ /* The largest integer which can be represented */
+ /* exactly in floating point form. */
+
+ static final double BIGGEST = 4503599627370496.0E0;
+ /* 2^52 for IEEE */
+
+ static private double Rint(double x)
+ {
+ final double biggest = BIGGEST;
+ double tmp;
+
+ if (x != x) return x; /* NaN */
+
+/*!* if (fabs(x) >= biggest) !!!COMMENT!!! *!*/
+ if (java.lang.Math.abs(x) >= biggest) /* Already integer */
+ return x;
+
+ if(x >= 0) {
+ tmp = x + biggest;
+ return tmp - biggest;
+ }
+ else {
+ tmp = x - biggest;
+ return tmp + biggest;
+ }
+ }
+
+ /*!* #else /*4!*/
+ //final double R_rint = rint;
+ /*!* #endif /*4!*/
+
+ public static double fround(double x, double digits)
+ {
+ double pow10, sgn, intx;
+ final double maxdigits = Constants.DBL_DIG - 1;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(digits))
+ return x + digits;
+ if(Double.isInfinite(x)) return x;
+ /*!* #endif /*4!*/
+
+/*!* digits = floor(digits + 0.5); *!*/
+ digits = java.lang.Math.floor(digits + 0.5);
+ if (digits > maxdigits)
+ digits = maxdigits;
+/*!* pow10 = pow(10.0, digits); *!*/
+ pow10 = java.lang.Math.pow(10.0, digits);
+ sgn = 1.0;
+ if(x < 0.0) {
+ sgn = -sgn;
+ x = -x;
+ }
+ if (digits > 0.0) {
+/*!* intx = floor(x); *!*/
+ intx = java.lang.Math.floor(x);
+ x = x - intx;
+ } else {
+ intx = 0.0;
+ }
+ return sgn * (intx + java.lang.Math.rint(x * pow10) / pow10);
+ }
+ /*
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double fsign(double x, double y);
+ *
+ * DESCRIPTION
+ *
+ * This function performs transfer of sign. The result is:
+ *
+ * |x| * signum(y)
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double fsign(double x, double y)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(y))
+ return x + y;
+ /*!* #endif /*4!*/
+/*!* return ((y >= 0) ? fabs(x) : -fabs(x)); *!*/
+ return ((y >= 0) ? java.lang.Math.abs(x) : -java.lang.Math.abs(x));
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double fsquare(double x);
+ *
+ * DESCRIPTION
+ *
+ * This function returns the square of its argument.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double fsquare(double x)
+ {
+ return x * x;
+ }
+
+ /**
+ * Truncation toward zero.
+ */
+ public static double ftrunc(double x) {
+ if (x >= 0) return java.lang.Math.floor(x);
+ else return java.lang.Math.ceil(x);
+ }
+
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double gammafn(double x);
+ *
+ * DESCRIPTION
+ *
+ * This function computes the value of the gamma function.
+ *
+ * NOTES
+ *
+ * This function is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ *
+ * The accuracy of this routine compares (very) favourably
+ * with those of the Sun Microsystems portable mathematical
+ * library.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static final double gamcs[] = {
+ +.8571195590989331421920062399942e-2,
+ +.4415381324841006757191315771652e-2,
+ +.5685043681599363378632664588789e-1,
+ -.4219835396418560501012500186624e-2,
+ +.1326808181212460220584006796352e-2,
+ -.1893024529798880432523947023886e-3,
+ +.3606925327441245256578082217225e-4,
+ -.6056761904460864218485548290365e-5,
+ +.1055829546302283344731823509093e-5,
+ -.1811967365542384048291855891166e-6,
+ +.3117724964715322277790254593169e-7,
+ -.5354219639019687140874081024347e-8,
+ +.9193275519859588946887786825940e-9,
+ -.1577941280288339761767423273953e-9,
+ +.2707980622934954543266540433089e-10,
+ -.4646818653825730144081661058933e-11,
+ +.7973350192007419656460767175359e-12,
+ -.1368078209830916025799499172309e-12,
+ +.2347319486563800657233471771688e-13,
+ -.4027432614949066932766570534699e-14,
+ +.6910051747372100912138336975257e-15,
+ -.1185584500221992907052387126192e-15,
+ +.2034148542496373955201026051932e-16,
+ -.3490054341717405849274012949108e-17,
+ +.5987993856485305567135051066026e-18,
+ -.1027378057872228074490069778431e-18,
+ +.1762702816060529824942759660748e-19,
+ -.3024320653735306260958772112042e-20,
+ +.5188914660218397839717833550506e-21,
+ -.8902770842456576692449251601066e-22,
+ +.1527474068493342602274596891306e-22,
+ -.2620731256187362900257328332799e-23,
+ +.4496464047830538670331046570666e-24,
+ -.7714712731336877911703901525333e-25,
+ +.1323635453126044036486572714666e-25,
+ -.2270999412942928816702313813333e-26,
+ +.3896418998003991449320816639999e-27,
+ -.6685198115125953327792127999999e-28,
+ +.1146998663140024384347613866666e-28,
+ -.1967938586345134677295103999999e-29,
+ +.3376448816585338090334890666666e-30,
+ -.5793070335782135784625493333333e-31
+ };
+
+ public static double gammafn(double x)
+ {
+ int ngam = 0;
+ double xmin = 0.;
+ double xmax = 0.;
+ double xsml = 0.;
+ double dxrel = 0.;
+ double temp[];
+
+ int i, n;
+ double y;
+ double sinpiy, value;
+
+ if (ngam == 0) {
+ ngam = chebyshev_init(gamcs, 42, 0.1 * d1mach(3));
+ temp = gammalims(xmin, xmax);
+ xmin=temp[0]; xmax=temp[1];
+/*!* xsml = exp(fmax2(log(d1mach(1)), -log(d1mach(2)))+0.01); *!*/
+ xsml = java.lang.Math.exp(fmax2(java.lang.Math.log(d1mach(1)), -java.lang.Math.log(d1mach(2)))+0.01);
+/*!* dxrel = sqrt(d1mach(4)); *!*/
+ dxrel = java.lang.Math.sqrt(d1mach(4));
+ }
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(x)) return x;
+ /*!* #endif /*4!*/
+
+/*!* y = fabs(x); *!*/
+ y = java.lang.Math.abs(x);
+
+ if (y <= 10) {
+
+ /* Compute gamma(x) for -10 <= x <= 10. */
+ /* Reduce the interval and find gamma(1 + y) for */
+ /* 0 <= y < 1 first of all. */
+
+ n = (int) x;
+ if(x < 0) --n;
+ y = x - n;/* n = floor(x) ==> y in [ 0, 1 ) */
+ --n;
+ value = chebyshev_eval(y * 2 - 1, gamcs, ngam) + .9375;
+ if (n == 0)
+ return value;/* x = 1.dddd = 1+y */
+
+ if (n < 0) {
+ /* compute gamma(x) for -10 <= x < 1 */
+
+ /* If the argument is exactly zero or a negative integer */
+ /* then return NaN. */
+ if (x == 0 || (x < 0 && x == n + 2)) {
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.NaN;
+ }
+
+ /* The answer is less than half precision */
+ /* because x too near a negative integer. */
+/*!* if (x < -0.5 && fabs(x - (int)(x - 0.5) / x) < dxrel) { *!*/
+ if (x < -0.5 && java.lang.Math.abs(x - (int)(x - 0.5) / x) < dxrel) {
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+
+ /* The argument is so close to 0 that the result would overflow. */
+ if (y < xsml) {
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // if(x > 0) return Double.POSITIVE_INFINITY;
+ // else return Double.NEGATIVE_INFINITY;
+ }
+
+ n = -n;
+
+ for (i = 0; i < n; i++) {
+ value /= (x + i);
+ }
+ return value;
+ }
+ else {
+ /* gamma(x) for 2 <= x <= 10 */
+
+ for (i = 1; i <= n; i++) {
+ value *= (y + i);
+ }
+ return value;
+ }
+ }
+ else {
+ /* gamma(x) for y = |x| > 10. */
+
+ if (x > xmax) { /* Overflow */
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.POSITIVE_INFINITY;
+ }
+
+ if (x < xmin) { /* Underflow */
+ throw new java.lang.ArithmeticException("Math Error: UNDERFLOW");
+ // return (Double.MIN_VALUE * Double.MIN_VALUE);
+ }
+
+/*!* value = exp((y - 0.5) * log(y) - y + Constants.M_LN_SQRT_2PI + lgammacor(y)); *!*/
+ value = java.lang.Math.exp((y - 0.5) * java.lang.Math.log(y) - y + Constants.M_LN_SQRT_2PI + lgammacor(y));
+
+ if (x > 0)
+ return value;
+
+/*!* if (fabs((x - (int)(x - 0.5))/x) < dxrel){ *!*/
+ if (java.lang.Math.abs((x - (int)(x - 0.5))/x) < dxrel){
+
+ /* The answer is less than half precision because */
+ /* the argument is too near a negative integer. */
+
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+
+/*!* sinpiy = sin(Constants.M_PI * y); *!*/
+ sinpiy = java.lang.Math.sin(Constants.M_PI * y);
+ if (sinpiy == 0) { /* Negative integer arg - overflow */
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.POSITIVE_INFINITY;
+ }
+
+ return -Constants.M_PI / (y * sinpiy * value);
+ }
+ }
+ /* From http://www.netlib.org/specfun/gamma Fortran translated by f2c,...
+ * ------------------------------##### Martin Maechler, ETH Zurich
+ *
+ *=========== was part of ribesl (Bessel I(.))
+ *=========== ~~~~~~
+ */
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double gamma_cody(double x)
+ {
+ /* ----------------------------------------------------------------------
+
+ This routine calculates the GAMMA function for a float argument X.
+ Computation is based on an algorithm outlined in reference [1].
+ The program uses rational functions that approximate the GAMMA
+ function to at least 20 significant decimal digits. Coefficients
+ for the approximation over the interval (1,2) are unpublished.
+ Those for the approximation for X >= 12 are from reference [2].
+ The accuracy achieved depends on the arithmetic system, the
+ compiler, the intrinsic functions, and proper selection of the
+ machine-dependent constants.
+
+ *******************************************************************
+
+ Error returns
+
+ The program returns the value XINF for singularities or
+ when overflow would occur. The computation is believed
+ to be free of underflow and overflow.
+
+ Intrinsic functions required are:
+
+ INT, DBLE, EXP, LOG, REAL, SIN
+
+
+ References:
+ [1] "An Overview of Software Development for Special Functions",
+ W. J. Cody, Lecture Notes in Mathematics, 506,
+ Numerical Analysis Dundee, 1975, G. A. Watson (ed.),
+ Springer Verlag, Berlin, 1976.
+
+ [2] Computer Approximations, Hart, Et. Al., Wiley and sons, New York, 1968.
+
+ Latest modification: October 12, 1989
+
+ Authors: W. J. Cody and L. Stoltz
+ Applied Mathematics Division
+ Argonne National Laboratory
+ Argonne, IL 60439
+ ----------------------------------------------------------------------*/
+
+ /* ----------------------------------------------------------------------
+ Mathematical constants
+ ----------------------------------------------------------------------*/
+ final double sqrtpi = .9189385332046727417803297; /* == ??? */
+
+ /* *******************************************************************
+
+ Explanation of machine-dependent constants
+
+ beta - radix for the floating-point representation
+ maxexp - the smallest positive power of beta that overflows
+ XBIG - the largest argument for which GAMMA(X) is representable
+ in the machine, i.e., the solution to the equation
+ GAMMA(XBIG) = beta**maxexp
+ XINF - the largest machine representable floating-point number;
+ approximately beta**maxexp
+ EPS - the smallest positive floating-point number such that 1.0+EPS > 1.0
+ XMININ - the smallest positive floating-point number such that
+ 1/XMININ is machine representable
+
+ Approximate values for some important machines are:
+
+ beta maxexp XBIG
+
+ CRAY-1 (S.P.) 2 8191 966.961
+ Cyber 180/855
+ under NOS (S.P.) 2 1070 177.803
+ IEEE (IBM/XT,
+ SUN, etc.) (S.P.) 2 128 35.040
+ IEEE (IBM/XT,
+ SUN, etc.) (D.P.) 2 1024 171.624
+ IBM 3033 (D.P.) 16 63 57.574
+ VAX D-Format (D.P.) 2 127 34.844
+ VAX G-Format (D.P.) 2 1023 171.489
+
+ XINF EPS XMININ
+
+ CRAY-1 (S.P.) 5.45E+2465 7.11E-15 1.84E-2466
+ Cyber 180/855
+ under NOS (S.P.) 1.26E+322 3.55E-15 3.14E-294
+ IEEE (IBM/XT,
+ SUN, etc.) (S.P.) 3.40E+38 1.19E-7 1.18E-38
+ IEEE (IBM/XT,
+ SUN, etc.) (D.P.) 1.79D+308 2.22D-16 2.23D-308
+ IBM 3033 (D.P.) 7.23D+75 2.22D-16 1.39D-76
+ VAX D-Format (D.P.) 1.70D+38 1.39D-17 5.88D-39
+ VAX G-Format (D.P.) 8.98D+307 1.11D-16 1.12D-308
+
+ *******************************************************************
+
+ ----------------------------------------------------------------------
+ Machine dependent parameters
+ ----------------------------------------------------------------------
+ */
+
+
+ final double xbig = 171.624;
+ /* ML_POSINF == static private double xinf = 1.79e308;*/
+ /* Constants.DBL_EPSILON = static private double eps = 2.22e-16;*/
+ /* Double.MIN_VALUE == static private double xminin = 2.23e-308;*/
+
+ /*----------------------------------------------------------------------
+ Numerator and denominator coefficients for rational minimax
+ approximation over (1,2).
+ ----------------------------------------------------------------------*/
+ // final double p[8] = {
+ final double p[] = {
+ -1.71618513886549492533811,
+ 24.7656508055759199108314,-379.804256470945635097577,
+ 629.331155312818442661052,866.966202790413211295064,
+ -31451.2729688483675254357,-36144.4134186911729807069,
+ 66456.1438202405440627855 };
+ // final double q[8] = {
+ final double q[] = {
+ -30.8402300119738975254353,
+ 315.350626979604161529144,-1015.15636749021914166146,
+ -3107.77167157231109440444,22538.1184209801510330112,
+ 4755.84627752788110767815,-134659.959864969306392456,
+ -115132.259675553483497211 };
+ /*----------------------------------------------------------------------
+ Coefficients for minimax approximation over (12, INF).
+ ----------------------------------------------------------------------*/
+ // final double c[7] = {
+ final double c[] = {
+ -.001910444077728,8.4171387781295e-4,
+ -5.952379913043012e-4,7.93650793500350248e-4,
+ -.002777777777777681622553,.08333333333333333331554247,
+ .0057083835261 };
+
+ /* Local variables */
+ long i, n;
+ boolean parity;/*logical*/
+ double fact, xden, xnum, y, z, y1, res, sum, ysq;
+
+ parity = false;
+ fact = 1.;
+ n = 0;
+ y = x;
+ L_end: {
+ if (y <= 0.) {
+ /* -------------------------------------------------------------
+ Argument is negative
+ ------------------------------------------------------------- */
+ y = -x;
+ y1 = ftrunc(y);
+ res = y - y1;
+ if (res != 0.) {
+ if (y1 != ftrunc(y1 * .5) * 2.)
+ parity = true;
+ /*!* fact = -Constants.M_PI / sin(Constants.M_PI * res); *!*/
+ fact = -Constants.M_PI / java.lang.Math.sin(Constants.M_PI * res);
+ y += 1.;
+ } else {
+ res = Double.POSITIVE_INFINITY;
+ break L_end;
+ }
+ }
+ /* -----------------------------------------------------------------
+ Argument is positive
+ -----------------------------------------------------------------*/
+ if (y < Constants.DBL_EPSILON) {
+ /* --------------------------------------------------------------
+ Argument < EPS
+ -------------------------------------------------------------- */
+ if (y >= Double.MIN_VALUE) {
+ res = 1. / y;
+ } else {
+ res = Double.POSITIVE_INFINITY;
+ break L_end;
+ }
+ } else if (y < 12.) {
+ y1 = y;
+ if (y < 1.) {
+ /* ---------------------------------------------------------
+ EPS < argument < 1
+ --------------------------------------------------------- */
+ z = y;
+ y += 1.;
+ } else {
+ /* -----------------------------------------------------------
+ 1 <= argument < 12, reduce argument if necessary
+ ----------------------------------------------------------- */
+ n = (long) y - 1;
+ y -= (double) n;
+ z = y - 1.;
+ }
+ /* ---------------------------------------------------------
+ Evaluate approximation for 1.0 < argument < 2.0
+ ---------------------------------------------------------*/
+ xnum = 0.;
+ xden = 1.;
+ for (i = 0; i < 8; ++i) {
+ xnum = (xnum + p[(int) i]) * z;
+ xden = xden * z + q[(int) i];
+ }
+ res = xnum / xden + 1.;
+ if (y1 < y) {
+ /* --------------------------------------------------------
+ Adjust result for case 0.0 < argument < 1.0
+ -------------------------------------------------------- */
+ res /= y1;
+ } else if (y1 > y) {
+ /* ----------------------------------------------------------
+ Adjust result for case 2.0 < argument < 12.0
+ ---------------------------------------------------------- */
+ for (i = 0; i < n; ++i) {
+ res *= y;
+ y += 1.;
+ }
+ }
+ } else {
+ /* -------------------------------------------------------------
+ Evaluate for argument >= 12.0,
+ ------------------------------------------------------------- */
+ if (y <= xbig) {
+ ysq = y * y;
+ sum = c[6];
+ for (i = 0; i < 6; ++i) {
+ sum = sum / ysq + c[(int) i];
+ }
+ sum = sum / y - y + sqrtpi;
+ /*!* sum += (y - .5) * log(y); *!*/
+ sum += (y - .5) * java.lang.Math.log(y);
+ /*!* res = exp(sum); *!*/
+ res = java.lang.Math.exp(sum);
+ } else {
+ res = Double.POSITIVE_INFINITY;
+ break L_end;
+ }
+ }
+ /* ----------------------------------------------------------------------
+ Final adjustments and return
+ ----------------------------------------------------------------------*/
+ if (parity)
+ res = -res;
+ if (fact != 1.)
+ res = fact / res;
+
+ } // L_end:
+ return res;
+ }
+
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * void gammalims(double *xmin, double *xmax);
+ *
+ * DESCRIPTION
+ *
+ * This function alculates the minimum and maximum legal bounds
+ * for x in gammafn(x). These are not the only bounds, but they
+ * are the only non-trivial ones to calculate.
+ *
+ * NOTES
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ /* FIXME: We need an ifdef'ed version of this which gives */
+ /* the exact values when we are using IEEE 754 arithmetic. */
+
+ static double[] gammalims(double xmin, double xmax)
+ {
+ double alnbig, alnsml, xln, xold;
+ int i;
+
+/*!* alnsml = log(d1mach(1)); *!*/
+ alnsml = java.lang.Math.log(d1mach(1));
+ xmin = -alnsml;
+ find_xmax: {
+ for (i=1; i<=10; ++i) {
+ xold = xmin;
+/*!* xln = log(*xmin); *!*/
+ xln = java.lang.Math.log(xmin);
+ xmin -= xmin * ((xmin + .5) * xln - xmin - .2258 + alnsml) /
+ (xmin * xln + .5);
+/*!* if (fabs(xmin - xold) < .005) { *!*/
+ if (java.lang.Math.abs(xmin - xold) < .005) {
+ xmin = -(xmin) + .01;
+ break find_xmax;
+ }
+ }
+
+ /* unable to find xmin */
+
+ throw new java.lang.ArithmeticException("Math Error: NOCONV");
+ // xmin = xmax = Double.NaN;
+
+ } // find_xmax:
+
+/*!* alnbig = log(d1mach(2)); *!*/
+ alnbig = java.lang.Math.log(d1mach(2));
+ xmax = alnbig;
+ done: {
+ for (i=1; i<=10; ++i) {
+ xold = xmax;
+/*!* xln = log(*xmax); *!*/
+ xln = java.lang.Math.log(xmax);
+ xmax -= xmax * ((xmax - .5) * xln - xmax + .9189 - alnbig) /
+ (xmax * xln - .5);
+/*!* if (fabs(xmax - xold) < .005) { *!*/
+ if (java.lang.Math.abs(xmax - xold) < .005) {
+ xmax += -.01;
+ break done;
+ }
+ }
+
+ /* unable to find xmax */
+
+ throw new java.lang.ArithmeticException("Math Error: NOCONV");
+ // xmin = xmax = Double.NaN;
+
+ } // done:
+ xmin = fmax2(xmin, -(xmax) + 1);
+
+ double retval[] = new double[2];
+ retval[0] = xmin;
+ retval[1] = xmax;
+ return(retval);
+ }
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static int i1mach(int i)
+ {
+ switch(i) {
+
+ case 1: return 5;
+ case 2: return 6;
+ case 3: return 0;
+ case 4: return 0;
+
+ case 5: /*return CHAR_BIT * sizeof(int);*/ throw new java.lang.RuntimeException("Unimplemented Feature.");
+ case 6: /*return sizeof(int)/sizeof(char);*/ throw new java.lang.RuntimeException("Unimplemented Feature.");
+
+ case 7: return 2;
+ case 8: /*return CHAR_BIT * sizeof(int) - 1;*/ throw new java.lang.RuntimeException("Unimplemented Feature.");
+ case 9: return java.lang.Integer.MAX_VALUE; /*INT_MAX;*/
+
+ case 10: return Constants.FLT_RADIX;
+
+ case 11: return Constants.FLT_MANT_DIG;
+ case 12: return Constants.FLT_MIN_EXP;
+ case 13: return Constants.FLT_MAX_EXP;
+
+ case 14: return Constants.DBL_MANT_DIG;
+ case 15: return Constants.DBL_MAX_EXP;
+ case 16: return Constants.DBL_MIN_EXP;
+
+ default: return 0;
+ }
+ }
+
+ int i1mach_(int i)
+ {
+ return i1mach(i);
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * int imax2(int x, int y);
+ *
+ * DESCRIPTION
+ *
+ * Compute maximum of two integers.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ int imax2(int x, int y)
+ {
+ return (x < y) ? y : x;
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * int Math.min(int x, int y);
+ *
+ * DESCRIPTION
+ *
+ * Compute minimum of two integers.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ int imin2(int x, int y)
+ {
+ return (x < y) ? x : y;
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double lbeta(double a, double b);
+ *
+ * DESCRIPTION
+ *
+ * This function returns the value of the log beta function.
+ *
+ * NOTES
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double lbeta(double a, double b)
+ {
+ double corr, p, q;
+
+ p = q = a;
+ if(b < p) p = b;/* := min(a,b) */
+ if(b > q) q = b;/* := max(a,b) */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(a) || Double.isNaN(b))
+ return a + b;
+ /*!* #endif /*4!*/
+
+ /* both arguments must be >= 0 */
+
+ if (p < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ else if (p == 0) {
+ return Double.POSITIVE_INFINITY;
+ }
+ /*!* #ifdef IEEE_754 /*4!*/
+ else if (Double.isInfinite(q)) {
+ return Double.NEGATIVE_INFINITY;
+ }
+ /*!* #endif /*4!*/
+
+ if (p >= 10) {
+ /* p and q are big. */
+ corr = lgammacor(p) + lgammacor(q) - lgammacor(p + q);
+/*!* return log(q) * -0.5 + Constants.M_LN_SQRT_2PI + corr *!*/
+ return java.lang.Math.log(q) * -0.5 + Constants.M_LN_SQRT_2PI + corr
+/*!* + (p - 0.5) * log(p / (p + q)) + q * logrelerr(-p / (p + q)); *!*/
+ + (p - 0.5) * java.lang.Math.log(p / (p + q)) + q * logrelerr(-p / (p + q));
+ }
+ else if (q >= 10) {
+ /* p is small, but q is big. */
+ corr = lgammacor(q) - lgammacor(p + q);
+/*!* return lgammafn(p) + corr + p - p * log(p + q) *!*/
+ return lgammafn(p) + corr + p - p * java.lang.Math.log(p + q)
+ + (q - 0.5) * logrelerr(-p / (p + q));
+ }
+ else
+ /* p and q are small: p <= q > 10. */
+/*!* return log(gammafn(p) * (gammafn(q) / gammafn(p + q))); *!*/
+ return java.lang.Math.log(gammafn(p) * (gammafn(q) / gammafn(p + q)));
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * extern int signgam;
+ * double lgammafn(double x);
+ *
+ * DESCRIPTION
+ *
+ * This function computes log|gamma(x)|. At the same time
+ * the variable "signgam" is set to the sign of the gamma
+ * function.
+ *
+ * NOTES
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * by W. Fullerton of Los Alamos Scientific Laboratory.
+ *
+ * The accuracy of this routine compares (very) favourably
+ * with those of the Sun Microsystems portable mathematical
+ * library.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static int signgam;
+
+ public static double lgammafn(double x)
+ {
+ double xmax = 0.;
+ double dxrel = 0.;
+ double ans, y, sinpiy;
+
+ if (xmax == 0) {
+/*!* xmax = d1mach(2)/log(d1mach(2)); *!*/
+ xmax = d1mach(2)/java.lang.Math.log(d1mach(2));
+ dxrel = java.lang.Math.sqrt (d1mach(4));
+ }
+
+ signgam = 1;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(x)) return x;
+ /*!* #endif /*4!*/
+
+ if (x <= 0 && x == (int)x) { /* Negative integer argument */
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.POSITIVE_INFINITY;/* +Inf, since lgamma(x) = log|gamma(x)| */
+ }
+
+/*!* y = fabs(x); *!*/
+ y = java.lang.Math.abs(x);
+
+ if (y <= 10) {
+/*!* return log(fabs(gammafn(x))); *!*/
+ return java.lang.Math.log(java.lang.Math.abs(gammafn(x)));
+ }
+ else { /* y = |x| > 10 */
+
+ if (y > xmax) {
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // return Double.POSITIVE_INFINITY;
+ }
+
+ if (x > 0)
+/*!* return Constants.M_LN_SQRT_2PI + (x - 0.5) * log(x) - x + lgammacor(y); *!*/
+ return Constants.M_LN_SQRT_2PI + (x - 0.5) * java.lang.Math.log(x) - x + lgammacor(y);
+
+ /* else: x < -10 */
+/*!* sinpiy = fabs(sin(Constants.M_PI * y)); *!*/
+ sinpiy = java.lang.Math.abs(java.lang.Math.sin(Constants.M_PI * y));
+
+ if (sinpiy == 0) { /* Negative integer argument ===
+ Now UNNECESSARY: caught above */
+ System.out.println(" ** should NEVER happen! *** [lgamma.c: Neg.int+ y=%g]\n"+y);
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+
+/*!* ans = Constants.M_LN_SQRT_PId2 + (x - 0.5) * log(y) - x *!*/
+ ans = Constants.M_LN_SQRT_PId2 + (x - 0.5) * java.lang.Math.log(y) - x
+/*!* - log(sinpiy) - lgammacor(y); *!*/
+ - java.lang.Math.log(sinpiy) - lgammacor(y);
+
+/*!* if(fabs((x - (int)(x - 0.5)) * ans / x) < dxrel) { *!*/
+ if(java.lang.Math.abs((x - (int)(x - 0.5)) * ans / x) < dxrel) {
+
+ /* The answer is less than half precision because */
+ /* the argument is too near a negative integer. */
+
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+
+ if (x > 0)
+ return ans;
+ else if (((int)(-x))%2 == 0)
+ signgam = -1;
+ return ans;
+ }
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double lgammacor(double x);
+ *
+ * DESCRIPTION
+ *
+ * Compute the log gamma correction factor for x >= 10 so that
+ *
+ * log(gamma(x)) = log(sqrt(2*pi))+(x-.5)*log(x)-x+lgammacor(x)
+ *
+ * NOTES
+ *
+ * This routine is a translation into C of a Fortran subroutine
+ * written by W. Fullerton of Los Alamos Scientific Laboratory.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double lgammacor(double x)
+ {
+ final double algmcs[] /*[15]*/ = {
+ +.1666389480451863247205729650822e+0,
+ -.1384948176067563840732986059135e-4,
+ +.9810825646924729426157171547487e-8,
+ -.1809129475572494194263306266719e-10,
+ +.6221098041892605227126015543416e-13,
+ -.3399615005417721944303330599666e-15,
+ +.2683181998482698748957538846666e-17,
+ -.2868042435334643284144622399999e-19,
+ +.3962837061046434803679306666666e-21,
+ -.6831888753985766870111999999999e-23,
+ +.1429227355942498147573333333333e-24,
+ -.3547598158101070547199999999999e-26,
+ +.1025680058010470912000000000000e-27,
+ -.3401102254316748799999999999999e-29,
+ +.1276642195630062933333333333333e-30
+ };
+ int nalgm = 0;
+ double xbig = 0;
+ double xmax = 0;
+ double tmp;
+
+ if (nalgm == 0) {
+ nalgm = chebyshev_init(algmcs, 15, d1mach(3));
+/*!* xbig = 1 / sqrt(d1mach(3)); *!*/
+ xbig = 1 / java.lang.Math.sqrt(d1mach(3));
+/*!* xmax = exp(fmin2(log(d1mach(2) / 12), -log(12 * d1mach(1)))); *!*/
+ xmax = java.lang.Math.exp(fmin2(java.lang.Math.log(d1mach(2) / 12), -java.lang.Math.log(12 * d1mach(1))));
+ }
+
+ if (x < 10) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ else if (x >= xmax) {
+ throw new java.lang.ArithmeticException("Math Error: UNDERFLOW");
+ // return (Double.MIN_VALUE * Double.MIN_VALUE);
+ }
+ else if (x < xbig) {
+ tmp = 10 / x;
+ return chebyshev_eval(tmp * tmp * 2 - 1, algmcs, nalgm) / x;
+ }
+ else return 1 / (x * 12);
+ }
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double dlnrel(double x);
+ *
+ * DESCRIPTION
+ *
+ * Compute the relative error logarithm.
+ *
+ * log(1 + x)
+ *
+ * NOTES
+ *
+ * This code is a translation of a Fortran subroutine of the
+ * same name written by W. Fullerton of Los Alamos Scientific
+ * Laboratory.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double logrelerr(double x)
+ {
+ /* series for alnr on the interval -3.75000e-01 to 3.75000e-01 */
+ /* with weighted error 6.35e-32 */
+ /* log weighted error 31.20 */
+ /* significant figures required 30.93 */
+ /* decimal places required 32.01 */
+ final double alnrcs[] /*[43]*/ = {
+ +.10378693562743769800686267719098e+1,
+ -.13364301504908918098766041553133e+0,
+ +.19408249135520563357926199374750e-1,
+ -.30107551127535777690376537776592e-2,
+ +.48694614797154850090456366509137e-3,
+ -.81054881893175356066809943008622e-4,
+ +.13778847799559524782938251496059e-4,
+ -.23802210894358970251369992914935e-5,
+ +.41640416213865183476391859901989e-6,
+ -.73595828378075994984266837031998e-7,
+ +.13117611876241674949152294345011e-7,
+ -.23546709317742425136696092330175e-8,
+ +.42522773276034997775638052962567e-9,
+ -.77190894134840796826108107493300e-10,
+ +.14075746481359069909215356472191e-10,
+ -.25769072058024680627537078627584e-11,
+ +.47342406666294421849154395005938e-12,
+ -.87249012674742641745301263292675e-13,
+ +.16124614902740551465739833119115e-13,
+ -.29875652015665773006710792416815e-14,
+ +.55480701209082887983041321697279e-15,
+ -.10324619158271569595141333961932e-15,
+ +.19250239203049851177878503244868e-16,
+ -.35955073465265150011189707844266e-17,
+ +.67264542537876857892194574226773e-18,
+ -.12602624168735219252082425637546e-18,
+ +.23644884408606210044916158955519e-19,
+ -.44419377050807936898878389179733e-20,
+ +.83546594464034259016241293994666e-21,
+ -.15731559416479562574899253521066e-21,
+ +.29653128740247422686154369706666e-22,
+ -.55949583481815947292156013226666e-23,
+ +.10566354268835681048187284138666e-23,
+ -.19972483680670204548314999466666e-24,
+ +.37782977818839361421049855999999e-25,
+ -.71531586889081740345038165333333e-26,
+ +.13552488463674213646502024533333e-26,
+ -.25694673048487567430079829333333e-27,
+ +.48747756066216949076459519999999e-28,
+ -.92542112530849715321132373333333e-29,
+ +.17578597841760239233269760000000e-29,
+ -.33410026677731010351377066666666e-30,
+ +.63533936180236187354180266666666e-31,
+ };
+ int nlnrel = 0;
+ double xmin = 0.;
+
+ if (nlnrel == 0) {
+ nlnrel = chebyshev_init(alnrcs, 43, 0.1 * d1mach(3));
+/*!* xmin = -1.0 + sqrt(d1mach(4)); *!*/
+ xmin = -1.0 + java.lang.Math.sqrt(d1mach(4));
+ }
+
+ if (x <= -1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+
+ if (x < xmin) {
+ /* answer less than half precision because x too near -1 */
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+
+/*!* if (fabs(x) <= .375) *!*/
+ if (java.lang.Math.abs(x) <= .375)
+ return x * (1 - x * chebyshev_eval(x / .375, alnrcs, nlnrel));
+ else
+/*!* return log(x + 1); *!*/
+ return java.lang.Math.log(x + 1);
+ }
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* These are used in IEEE exception handling */
+ static double m_zero = 0;
+ static double m_one = 1;
+ static double m_tiny = Double.MIN_VALUE;
+ /*!* #endif /*4!*/
+
+ /*!* #ifndef IEEE_754 /*4!*/
+
+ /*
+ void ml_error(int n)
+ {
+ switch(n) {
+
+ case "Math Error: NONE":
+ (!!!!fixme!!!!) = 0;
+ break;
+
+ case "Math Error: DOMAIN":
+ case "Math Error: NOCONV":
+ (!!!!fixme!!!!) = EDOM;
+ break;
+
+ case "Math Error: RANGE":
+ (!!!!fixme!!!!) = ERANGE;
+ break;
+
+ default:
+ break;
+ }
+ }
+
+ */
+ /*!* #endif /*4!*/
+ /*
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double sign(double x);
+ *
+ * DESCRIPTION
+ *
+ * This function computes the 'signum(.)' function:
+ *
+ * sign(x) = 1 if x > 0
+ * sign(x) = 0 if x == 0
+ * sign(x) = -1 if x < 0
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double sign(double x)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x))
+ return x;
+ /*!* #endif /*4!*/
+ return ((x > 0) ? 1 : ((x == 0)? 0 : -1));
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NegativeBinomial.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NegativeBinomial.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NegativeBinomial.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NegativeBinomial.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,286 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class NegativeBinomial
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n, double p);
+ *
+ * DESCRIPTION
+ *
+ * The density function of the negative binomial distribution.
+ *
+ * NOTES
+ *
+ * x = the number of failures before the n-th success
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double n, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p))
+ return x + n + p;
+ /*!* #endif /*4!*/
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (n < 1 || p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0)
+ return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(x))
+ return 0;
+ /*!* #endif /*4!*/
+/*!* return exp(lfastchoose(x + n - 1, x) *!*/
+ return java.lang.Math.exp(Misc.lfastchoose(x + n - 1, x)
+/*!* + n * log(p) + x * log(1 - p)); *!*/
+ + n * java.lang.Math.log(p) + x * java.lang.Math.log(1 - p));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double n, double p);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the negative binomial distribution.
+ *
+ * NOTES
+ *
+ * x = the number of failures before the n-th success
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n, double p)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p))
+ return x + n + p;
+ if(Double.isInfinite(n) || Double.isInfinite(p)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (n < 1 || p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(x))
+ return 1;
+ /*!* #endif /*4!*/
+ return Beta.cumulative(p, n, x + 1);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double n, double p);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the negative binomial distribution.
+ *
+ * NOTES
+ *
+ * x = the number of failures before the n-th success
+ *
+ * METHOD
+ *
+ * Uses the Cornish-Fisher Expansion to include a skewness
+ * correction to a Normal approximation. This gives an
+ * initial value which never seems to be off by more than
+ * 1 or 2. A search is then conducted of values close to
+ * this initial start point.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double n, double p)
+ {
+ double P, Q, mu, sigma, gamma, z, y;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n) || Double.isNaN(p))
+ return x + n + p;
+ if (Double.isInfinite(x)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (x < 0 || x > 1 || p <= 0 || p >= 1 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (x == 1) return Double.POSITIVE_INFINITY;
+ /*!* #endif /*4!*/
+ Q = 1.0 / p;
+ P = (1.0 - p) * Q;
+ mu = n * P;
+/*!* sigma = sqrt(n * P * Q); *!*/
+ sigma = java.lang.Math.sqrt(n * P * Q);
+ gamma = (Q + P)/sigma;
+ z = Normal.quantile(x, 0.0, 1.0);
+/*!* y = floor(mu + sigma * (z + Gamma * (z*z - 1.0) / 6.0) + 0.5); *!*/
+ y = java.lang.Math.floor(mu + sigma * (z + gamma * (z*z - 1.0) / 6.0) + 0.5);
+
+ z = cumulative(y, n, p);
+ if(z >= x) {
+
+ /* search to the left */
+
+ for(;;) {
+ if((z = cumulative(y - 1, n, p)) < x)
+ return y;
+ y = y - 1;
+ }
+ }
+ else {
+
+ /* search to the right */
+
+ for(;;) {
+ if((z = cumulative(y + 1, n, p)) >= x)
+ return y + 1;
+ y = y + 1;
+ }
+ }
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n, double p);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the negative binomial distribution.
+ *
+ * NOTES
+ *
+ * x = the number of failures before the n-th success
+ *
+ * REFERENCE
+ *
+ * Devroye, L. (1980).
+ * Non-Uniform Random Variate Generation.
+ * New York:Springer-Verlag. Page 480.
+ *
+ * METHOD
+ *
+ * Generate lambda as Gamma with shape parameter n and scale
+ * parameter p/(1-p). Return a Poisson deviate with mean lambda.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double n, double p, Uniform uniformDistribution)
+ {
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if(
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(n) || Double.isInfinite(p) ||
+ /*!* #endif /*4!*/
+ n <= 0 || p <= 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ return Poisson.random(Gamma.random(n, (1 - p) / p, uniformDistribution), uniformDistribution);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralBeta.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralBeta.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralBeta.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralBeta.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,198 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class NoncentralBeta
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double a, double b, double lambda);
+ *
+ * DESCRIPTION
+ *
+ * Computes the density of the noncentral Beta distribution with
+ * noncentrality parameter lambda. The noncentral Beta distribution
+ * has density:
+ *
+ * Inf
+ * f(x|a,b,d) = SUM p(i) * B(a+i,b) * x^(a+i-1) * (1-x)^(b-1)
+ * i=0
+ *
+ * where:
+ *
+ * p(k) = exp(-lambda) lambda^k / k!
+ *
+ * B(a,b) = Gamma(a+b) / (Gamma(a) * Gamma(b))
+ *
+ *
+ * This can be computed efficiently by using the recursions:
+ *
+ * p(k+1) = (lambda/(k+1)) * p(k-1)
+ *
+ * B(a+k+1,b) = ((a+b+k)/(a+k)) * B(a+k,b)
+ *
+ * The summation of the series continues until
+ *
+ * psum = p(0) + ... + p(k)
+ *
+ * is close to 1. Here we continue until 1 - psum < epsilon,
+ * with epsilon set close to the relative machine precision.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double a, double b, double lambda)
+ {
+ double k, lambda2, psum, sum, term, weight;
+ final double eps = 1.e-14;
+ final int maxiter = 200;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b) || Double.isNaN(lambda))
+ return x + a + b + lambda;
+ /*!* #endif /*4!*/
+
+ if (lambda < 0 || a <= 0 || b <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(a) || Double.isInfinite(b) || Double.isInfinite(lambda)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+ if(x <= 0) return 0;
+
+ term = Beta.density(x, a, b);
+ if(lambda == 0)
+ return term;
+
+ lambda2 = 0.5 * lambda;
+/*!* weight = exp(- lambda2); *!*/
+ weight = java.lang.Math.exp(- lambda2);
+ sum = weight * term;
+ psum = weight;
+ for(k=1 ; k<=maxiter ; k++) {
+ weight = weight * lambda2 / k;
+ term = term * x * (a + b) / a;
+ sum = sum + weight * term;
+ psum = psum + weight;
+ a = a + 1;
+ if(1 - psum < eps) break;
+ }
+ return sum;
+ }
+ /*
+ * Algorithm AS 226 Appl. Statist. (1987) Vol. 36, No. 2
+ * Incorporates modification AS R84 from AS Vol. 39, pp311-2, 1990
+ *
+ * Returns the cumulative probability of x for the non-central
+ * Beta distribution with parameters a, b and non-centrality lambda.
+ *
+ * Auxiliary routines required:
+ * lgamma - log-gamma function
+ * pbeta - incomplete-Beta function
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double a, double b, double lambda)
+ {
+ double a0, ans, ax, lbeta, c, errbd, gx, q, sumq, temp, x0;
+ int j;
+
+ final double zero = 0;
+ final double one = 1;
+ final double half = 0.5;
+
+ /* change errmax and itrmax if desired */
+
+ final double ualpha = 5.0;
+ final double errmax = 1.0e-6;
+ final int itrmax = 100;
+
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b) || Double.isNaN(lambda))
+ return x + a + b + lambda;
+ /*!* #endif /*4!*/
+
+ if (lambda < zero || a <= zero || b <= zero) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+
+ if (x <= zero) return 0;
+ if(x >= one) return 1;
+
+ c = lambda * half;
+
+ /* initialize the series */
+
+/*!* x0 = floor(fmax2(c - ualpha * sqrt(c), zero)); *!*/
+ x0 = java.lang.Math.floor(Math.max(c - ualpha * java.lang.Math.sqrt(c), zero));
+ a0 = a + x0;
+/*!* lbeta = lgammafn(a0) + lgammafn(b) - lgammafn(a0 + b); *!*/
+ lbeta = Misc.lgammafn(a0) + Misc.lgammafn(b) - Misc.lgammafn(a0 + b);
+ temp = Beta.cumulative(x, a0, b);
+/*!* gx = exp(a0 * log(x) + b * log(one - x) - lbeta - log(a0)); *!*/
+ gx = java.lang.Math.exp(a0 * java.lang.Math.log(x) + b * java.lang.Math.log(one - x) - lbeta - java.lang.Math.log(a0));
+ if (a0 > a)
+/*!* q = exp(-c + x0 * log(c) - lgammafn(x0 + one)); *!*/
+ q = java.lang.Math.exp(-c + x0 * java.lang.Math.log(c) - Misc.lgammafn(x0 + one));
+ else
+/*!* q = exp(-c); *!*/
+ q = java.lang.Math.exp(-c);
+
+ ax = q * temp;
+ sumq = one - q;
+ ans = ax;
+
+ /* recur over subsequent terms */
+ /* until convergence is achieved */
+ j = 0;
+ do {
+ j++;
+ temp += - gx;
+ gx *= x * (a + b + j - one) / (a + j);
+ q *= c / j;
+ sumq += - q;
+ ax = temp * q;
+ ans += ax;
+ errbd = (temp - gx) * sumq;
+ }
+ while (errbd > errmax && j < itrmax);
+
+ if (errbd > errmax) {
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ }
+ return ans;
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralChiSquare.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralChiSquare.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralChiSquare.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralChiSquare.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,279 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class NoncentralChiSquare
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(x, df, lambda);
+ *
+ * DESCRIPTION
+ *
+ * The density of the noncentral Chisquare distribution with
+ * "df" degrees of freedom and noncentrality parameter "lambda".
+ *
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double df, double lambda)
+ {
+ double dens, i, lambda2, psum, sum, weight;
+ final int maxiter = 100;
+ final double eps = 1.e-14;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(df) || Double.isNaN(lambda))
+ return x + df + lambda;
+ /*!* #endif /*4!*/
+
+ if (lambda < 0 || df <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(df) || Double.isInfinite(lambda)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+ if(x <= 0) return 0;
+
+ dens = Chisquare.density(x, df);
+ if(lambda == 0)
+ return dens;
+
+ lambda2 = 0.5 * lambda;
+/*!* weight = exp(-lambda2); *!*/
+ weight = java.lang.Math.exp(-lambda2);
+ sum = weight * dens;
+ psum = weight;
+ for(i=1 ; i t=%12g\n",v,x2,f2,t); *!*/
+ // REprintf("\t v=java.lang.Math.exp(-th/2)=%12g, x/2=%12g, f/2=%12g ==> t=%12g\n",v,x2,f2,t);
+ /*!* #endif /*4!*/
+
+ /* check if (f+2n) is greater than x */
+
+ flag = false;
+ n = 1; twon = n*2;
+ L_End: for(;;) {
+ /*!* #ifdef DEBUG_pnch /*4!*/
+ // REprintf(" _OL_: n=%d",n);
+ /*!* #endif /*4!*/
+ if (!(f + twon - x > zero)) {
+ /* evaluate the next term of the */
+ /* expansion and then the partial sum */
+ u *= lam / n;
+ v += u;
+ t *= x / (f + twon);
+ term = v * t;
+ ans += term;
+ n++; twon = n*2;
+ }
+ else
+ {
+ /* find the error bound and check for convergence */
+ flag = true;
+
+ for(;;) {
+ /*!* #ifdef DEBUG_pnch /*4!*/
+ // REprintf(" il: n=%d",n);
+ /*!* #endif /*4!*/
+
+ bound = t * x / (f + twon - x);
+ /*!* #ifdef DEBUG_pnch /*4!*/
+ // REprintf("\tL10: n=%d; term=%12g; bound=%12g\n",n,term,bound);
+ /*!* #endif /*4!*/
+ if (bound <= errmax || n > itrmax)
+ break L_End;
+ /* evaluate the next term of the */
+ /* expansion and then the partial sum */
+ u *= lam / n;
+ v += u;
+ t *= x / (f + twon);
+ term = v * t;
+ ans += term;
+ n++; twon = n*2;
+ }
+
+ }
+ }// L_End:
+ if (bound > errmax)
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ /*!* #ifdef DEBUG_pnch /*4!*/
+ // REprintf("\tL_End: n=%d; term=%12g; bound=%12g\n",n,term,bound);
+ /*!* #endif /*4!*/
+ return ans;
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double p, double n, double lambda)
+ {
+ double ux, lx, nx;
+ double acu = 1.0e-12;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(p) || Double.isNaN(n) || Double.isNaN(lambda))
+ return p + n + lambda;
+ if (Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (p < 0 || p >= 1 || n < 1 || lambda < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (p == 0)
+ return 0;
+ for (ux = 1.0; cumulative(ux, n, lambda) < p; ux *= 2);
+ for (lx = ux; cumulative(lx, n, lambda) > p; lx *= 0.5);
+ do {
+ nx = 0.5 * (lx + ux);
+ if (cumulative(nx, n, lambda) > p)
+ ux = nx;
+ else
+ lx = nx;
+ }
+ while ((ux - lx) / nx > acu);
+ return 0.5 * (ux + lx);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralF.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralF.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/NoncentralF.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/NoncentralF.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,59 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class NoncentralF
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double n1, double n2, double ncp);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the non-central F distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n1, double n2, double ncp)
+ {
+ double y;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n1) || Double.isNaN(n2) || Double.isNaN(ncp))
+ return x + n2 + n1 + ncp;
+ /*!* #endif /*4!*/
+ if (n1 <= 0.0 || n2 <= 0.0 || ncp < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0.0)
+ return 0.0;
+ y = (n1 / n2) * x;
+ return NoncentralBeta.cumulative(y/(1 + y), n1 / 2.0, n2 / 2.0, ncp);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Noncentral_t.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Noncentral_t.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Noncentral_t.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Noncentral_t.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,113 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Noncentral_t
+ {
+ /*
+ * Algorithm AS 243 Appl. Statist. (1989), Vol.38, No. 1.
+ *
+ * Cumulative probability at t of the non-central t-distribution
+ * with df degrees of freedom (may be fractional) and non-centrality
+ * parameter delta.
+ *
+ * NOTE
+ *
+ * Requires the following auxiliary routines:
+ *
+ * lgammafn(x) - log gamma function
+ * Beta.cumulative(x, a, b) - incomplete Beta function
+ * Normal.cumulative(x) - Normal distribution function
+ *
+ * CONSTANTS
+ *
+ * M_SQRT_2dPI = 1/ {gamma(1.5) * sqrt(2)} = sqrt(2 / pi)
+ * M_LN_SQRT_PI = ln(sqrt(pi)) = ln(pi)/2
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double t, double df, double delta)
+ {
+ double a, albeta, b, del, en, errbd, geven, godd;
+ double lambda, p, q, rxb, s, tnc, tt, x, xeven, xodd;
+ boolean negdel;
+
+ /* note - itrmax and errmax may be changed to suit one's needs. */
+
+ final double itrmax = 100.1;
+ final double errmax = 1.e-12;
+
+ final double zero = 0.0;
+ final double half = 0.5;
+ final double one = 1.0;
+ final double two = 2.0;
+
+ tnc = zero;
+ if (df <= zero) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ tt = t;
+ del = delta;
+ negdel = false;
+ if (t < zero) {
+ negdel = true;
+ tt = -tt;
+ del = -del;
+ }
+ /* initialize twin series */
+ /* (guenther, j. statist. computn. simuln. vol.6, 199, 1978). */
+
+ en = one;
+ x = t * t / (t * t + df);
+ if (x > zero) {
+ lambda = del * del;
+/*!* p = half * exp(-half * lambda); *!*/
+ p = half * java.lang.Math.exp(-half * lambda);
+ q = Constants.M_SQRT_2dPI * p * del;
+ s = half - p;
+ a = half;
+ b = half * df;
+/*!* rxb = pow(one - x, b); *!*/
+ rxb = java.lang.Math.pow(one - x, b);
+/*!* albeta = Constants.M_LN_SQRT_PI + lgammafn(b) - lgammafn(a + b); *!*/
+ albeta = Constants.M_LN_SQRT_PI + Misc.lgammafn(b) - Misc.lgammafn(a + b);
+ xodd = Beta.cumulative(x, a, b);
+/*!* godd = two * rxb * exp(a * log(x) - albeta); *!*/
+ godd = two * rxb * java.lang.Math.exp(a * java.lang.Math.log(x) - albeta);
+ xeven = one - rxb;
+ geven = b * x * rxb;
+ tnc = p * xodd + q * xeven;
+
+ /* while(true) until convergence */
+
+ do {
+ a = a + one;
+ xodd = xodd - godd;
+ xeven = xeven - geven;
+ godd = godd * x * (a + b - one) / a;
+ geven = geven * x * (a + b - half) / (a + half);
+ p = p * lambda / (two * en);
+ q = q * lambda / (two * en + one);
+ s = s - p;
+ en = en + one;
+ tnc = tnc + p * xodd + q * xeven;
+ errbd = two * s * (xodd - godd);
+ }
+ while (errbd > errmax && en <= itrmax);
+ }
+ if (en <= itrmax)
+ throw new java.lang.ArithmeticException("Math Error: PRECISION");
+ tnc = tnc + Normal.cumulative(- del, zero, one);
+ if (negdel)
+ tnc = one - tnc;
+ return tnc;
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Normal.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Normal.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Normal.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Normal.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,679 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Normal
+ {
+
+ /* Mathematical Constants */
+ static private double SIXTEN = 1.6; /* Magic Cutoff */
+
+
+ /*
+ * M_1_SQRT_2PI = 1 / sqrt(2 * pi)
+ */
+
+ /** The Normal Density Function */
+ public static double density(double x, double mu, double sigma)
+ {
+ if (Double.isNaN(x) || Double.isNaN(mu) || Double.isNaN(sigma))
+ return x + mu + sigma;
+ if (sigma <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ x = (x - mu) / sigma;
+ return Constants.M_1_SQRT_2PI *
+ java.lang.Math.exp(-0.5 * x * x) / sigma;
+ }
+
+ /** DESCRIPTION
+ * The main computation evaluates near-minimax approximations derived
+ * from those in "Rational Chebyshev approximations for the error
+ * function" by W. J. Cody, Math. Comp., 1969, 631-637. This
+ * transportable program uses rational functions that theoretically
+ * approximate the Normal distribution function to at least 18
+ * significant decimal digits. The accuracy achieved depends on the
+ * arithmetic system, the compiler, the intrinsic functions, and
+ * proper selection of the machine-dependent constants.
+ *
+ * REFERENCE
+ *
+ * Cody, W. D. (1993).
+ * ALGORITHM 715: SPECFUN - A Portable FORTRAN Package of
+ * Special Function Routines and Test Drivers".
+ * ACM Transactions on Mathematical Software. 19, 22-32.
+ */
+
+ public static double cumulative(double x, double mu, double sigma)
+ {
+ final double c[] = {
+ 0.39894151208813466764,
+ 8.8831497943883759412,
+ 93.506656132177855979,
+ 597.27027639480026226,
+ 2494.5375852903726711,
+ 6848.1904505362823326,
+ 11602.651437647350124,
+ 9842.7148383839780218,
+ 1.0765576773720192317e-8
+ };
+
+ final double d[] = {
+ 22.266688044328115691,
+ 235.38790178262499861,
+ 1519.377599407554805,
+ 6485.558298266760755,
+ 18615.571640885098091,
+ 34900.952721145977266,
+ 38912.003286093271411,
+ 19685.429676859990727
+ };
+
+ final double p[] = {
+ 0.21589853405795699,
+ 0.1274011611602473639,
+ 0.022235277870649807,
+ 0.001421619193227893466,
+ 2.9112874951168792e-5,
+ 0.02307344176494017303
+ };
+
+ final double q[] = {
+ 1.28426009614491121,
+ 0.468238212480865118,
+ 0.0659881378689285515,
+ 0.00378239633202758244,
+ 7.29751555083966205e-5
+ };
+
+ final double a[] = {
+ 2.2352520354606839287,
+ 161.02823106855587881,
+ 1067.6894854603709582,
+ 18154.981253343561249,
+ 0.065682337918207449113
+ };
+
+ final double b[] = {
+ 47.20258190468824187,
+ 976.09855173777669322,
+ 10260.932208618978205,
+ 45507.789335026729956
+ };
+
+ double xden, temp, xnum, result, ccum;
+ double del, min, eps, xsq;
+ double y;
+ int i;
+
+ /* Note: The structure of these checks has been */
+ /* carefully thought through. For example, if x == mu */
+ /* and sigma == 0, we still get the correct answer. */
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(x) || Double.isNaN(mu) || Double.isNaN(sigma))
+ return x + mu + sigma;
+ /*!* #endif /*4!*/
+ if (sigma < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ x = (x - mu) / sigma;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x)) {
+ if(x < 0) return 0;
+ else return 1;
+ }
+ /*!* #endif /*4!*/
+
+ eps = Constants.DBL_EPSILON * 0.5;
+ min = Double.MIN_VALUE;
+/*!* y = fabs(x); *!*/
+ y = java.lang.Math.abs(x);
+ if (y <= 0.66291) {
+ xsq = 0.0;
+ if (y > eps) {
+ xsq = x * x;
+ }
+ xnum = a[4] * xsq;
+ xden = xsq;
+ for (i = 1; i <= 3; ++i) {
+ xnum = (xnum + a[i - 1]) * xsq;
+ xden = (xden + b[i - 1]) * xsq;
+ }
+ result = x * (xnum + a[3]) / (xden + b[3]);
+ temp = result;
+ result = 0.5 + temp;
+ ccum = 0.5 - temp;
+ }
+ else if (y <= Constants.M_SQRT_32) {
+
+ /* Evaluate pnorm for 0.66291 <= |z| <= sqrt(32) */
+
+ xnum = c[8] * y;
+ xden = y;
+ for (i = 1; i <= 7; ++i) {
+ xnum = (xnum + c[i - 1]) * y;
+ xden = (xden + d[i - 1]) * y;
+ }
+ result = (xnum + c[7]) / (xden + d[7]);
+/*!* xsq = floor(y * SIXTEN) / SIXTEN; *!*/
+ xsq = java.lang.Math.floor(y * SIXTEN) / SIXTEN;
+ del = (y - xsq) * (y + xsq);
+/*!* result = exp(-xsq * xsq * 0.5) * exp(-del * 0.5) * result; *!*/
+ result = java.lang.Math.exp(-xsq * xsq * 0.5) * java.lang.Math.exp(-del * 0.5) * result;
+ ccum = 1.0 - result;
+ if (x > 0.0) {
+ temp = result;
+ result = ccum;
+ ccum = temp;
+ }
+ }
+ else if(y < 50) {
+
+ /* Evaluate pnorm for sqrt(32) < |z| < 50 */
+
+ result = 0.0;
+ xsq = 1.0 / (x * x);
+ xnum = p[5] * xsq;
+ xden = xsq;
+ for (i = 1; i <= 4; ++i) {
+ xnum = (xnum + p[i - 1]) * xsq;
+ xden = (xden + q[i - 1]) * xsq;
+ }
+ result = xsq * (xnum + p[4]) / (xden + q[4]);
+ result = (Constants.M_1_SQRT_2PI - result) / y;
+/*!* xsq = floor(x * SIXTEN) / SIXTEN; *!*/
+ xsq = java.lang.Math.floor(x * SIXTEN) / SIXTEN;
+ del = (x - xsq) * (x + xsq);
+/*!* result = exp(-xsq * xsq * 0.5) * exp(-del * 0.5) * result; *!*/
+ result = java.lang.Math.exp(-xsq * xsq * 0.5) * java.lang.Math.exp(-del * 0.5) * result;
+ ccum = 1.0 - result;
+ if (x > 0.0) {
+ temp = result;
+ result = ccum;
+ ccum = temp;
+ }
+ }
+ else {
+ if(x > 0) {
+ result = 1.0;
+ ccum = 0.0;
+ }
+ else {
+ result = 0.0;
+ ccum = 1.0;
+ }
+ }
+ if (result < min) {
+ result = 0.0;
+ }
+ if (ccum < min) {
+ ccum = 0.0;
+ }
+ return result;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * double cumulative(double p, double mu, double sigma);
+ *
+ * DESCRIPTION
+ *
+ * Compute the quantile function for the Normal distribution.
+ *
+ * For small to moderate probabilities, algorithm referenced
+ * below is used to obtain an initial approximation which is
+ * polished with a final Newton step.
+ *
+ * For very large arguments, an algorithm of Wichura is used.
+ *
+ * REFERENCE
+ *
+ * Beasley, J. D. and S. G. Springer (1977).
+ * Algorithm AS 111: The percentage points of the Normal distribution,
+ * Applied Statistics, 26, 118-121.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+
+ public static double quantile(double p, double mu, double sigma)
+ {
+ double q, r, val;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(p) || Double.isNaN(mu) || Double.isNaN(sigma))
+ return p + mu + sigma;
+ /*!* #endif /*4!*/
+ if (p < 0.0 || p > 1.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+
+ q = p - 0.5;
+
+/*!* if (fabs(q) <= 0.42) { *!*/
+ if (java.lang.Math.abs(q) <= 0.42) {
+
+ /* 0.08 < p < 0.92 */
+
+ r = q * q;
+ val = q * (((-25.44106049637 * r + 41.39119773534) * r
+ - 18.61500062529) * r + 2.50662823884)
+ / ((((3.13082909833 * r - 21.06224101826) * r
+ + 23.08336743743) * r + -8.47351093090) * r + 1.0);
+ }
+ else {
+
+ /* p < 0.08 or p > 0.92, set r = min(p, 1 - p) */
+
+ r = p;
+ if (q > 0.0)
+ r = 1.0 - p;
+
+ if(r > Constants.DBL_EPSILON) {
+/*!* r = sqrt(-log(r)); *!*/
+ r = java.lang.Math.sqrt(-java.lang.Math.log(r));
+ val = (((2.32121276858 * r + 4.85014127135) * r
+ - 2.29796479134) * r - 2.78718931138)
+ / ((1.63706781897 * r + 3.54388924762) * r + 1.0);
+ if (q < 0.0)
+ val = -val;
+ }
+ else if(r > 1e-300) { /* Assuming IEEE here? */
+/*!* val = -2 * log(p); *!*/
+ val = -2 * java.lang.Math.log(p);
+/*!* r = log(6.283185307179586476925286766552 * val); *!*/
+ r = java.lang.Math.log(6.283185307179586476925286766552 * val);
+ r = r/val + (2 - r)/(val * val)
+ + (-14 + 6 * r - r * r)/(2 * val * val * val);
+/*!* val = sqrt(val * (1 - r)); *!*/
+ val = java.lang.Math.sqrt(val * (1 - r));
+ if(q < 0.0)
+ val = -val;
+ return val;
+ }
+ else {
+ throw new java.lang.ArithmeticException("Math Error: RANGE");
+ // if(q < 0.0) {
+ // return Double.NEGATIVE_INFINITY;
+ // }
+ // else {
+ // return Double.POSITIVE_INFINITY;
+ // }
+ }
+ }
+ val = val - (cumulative(val, 0.0, 1.0) - p) / Normal.density(val, 0.0, 1.0);
+ return mu + sigma * val;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double mu, double sigma, Uniform uniformDistribution );
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Normal distribution.
+ *
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double mu, double sigma, Uniform uniformDistribution)
+ {
+ if(
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(mu) || Double.isInfinite(sigma) ||
+ /*!* #endif /*4!*/
+ sigma < 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ } else
+ if (sigma == 0.0)
+ return mu;
+ else
+ return mu + sigma * random(uniformDistribution);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(void);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the STANDARD Normal distribution N(0,1).
+ *
+ * Is called from random(..), but also rt(), rf(), rgamma(), ...
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ /*!* #define KINDERMAN_RAMAGE /*4!*/
+
+ /*!* #ifdef AHRENS_DIETER /*4!*/
+
+ /*
+ * REFERENCE
+ *
+ * Ahrens, J.H. and Dieter, U.
+ * Extensions of Forsythe's method for random sampling from
+ * the Normal distribution.
+ * Math. Comput. 27, 927-937.
+ *
+ * The definitions of the constants a[k], d[k], t[k] and
+ * h[k] are according to the abovementioned article
+ */
+ public static double random_AhrensDieter( Uniform uniformDistribution )
+ {
+ final double a[] =
+ {
+ 0.0000000, 0.03917609, 0.07841241, 0.1177699,
+ 0.1573107, 0.19709910, 0.23720210, 0.2776904,
+ 0.3186394, 0.36012990, 0.40225010, 0.4450965,
+ 0.4887764, 0.53340970, 0.57913220, 0.6260990,
+ 0.6744898, 0.72451440, 0.77642180, 0.8305109,
+ 0.8871466, 0.94678180, 1.00999000, 1.0775160,
+ 1.1503490, 1.22985900, 1.31801100, 1.4177970,
+ 1.5341210, 1.67594000, 1.86273200, 2.1538750
+ };
+
+ final double d[] =
+ {
+ 0.0000000, 0.0000000, 0.0000000, 0.0000000,
+ 0.0000000, 0.2636843, 0.2425085, 0.2255674,
+ 0.2116342, 0.1999243, 0.1899108, 0.1812252,
+ 0.1736014, 0.1668419, 0.1607967, 0.1553497,
+ 0.1504094, 0.1459026, 0.1417700, 0.1379632,
+ 0.1344418, 0.1311722, 0.1281260, 0.1252791,
+ 0.1226109, 0.1201036, 0.1177417, 0.1155119,
+ 0.1134023, 0.1114027, 0.1095039
+ };
+
+ final double t[] =
+ {
+ 7.673828e-4, 0.002306870, 0.003860618, 0.005438454,
+ 0.007050699, 0.008708396, 0.010423570, 0.012209530,
+ 0.014081250, 0.016055790, 0.018152900, 0.020395730,
+ 0.022811770, 0.025434070, 0.028302960, 0.031468220,
+ 0.034992330, 0.038954830, 0.043458780, 0.048640350,
+ 0.054683340, 0.061842220, 0.070479830, 0.081131950,
+ 0.094624440, 0.112300100, 0.136498000, 0.171688600,
+ 0.227624100, 0.330498000, 0.584703100
+ };
+
+ final double h[] =
+ {
+ 0.03920617, 0.03932705, 0.03950999, 0.03975703,
+ 0.04007093, 0.04045533, 0.04091481, 0.04145507,
+ 0.04208311, 0.04280748, 0.04363863, 0.04458932,
+ 0.04567523, 0.04691571, 0.04833487, 0.04996298,
+ 0.05183859, 0.05401138, 0.05654656, 0.05953130,
+ 0.06308489, 0.06737503, 0.07264544, 0.07926471,
+ 0.08781922, 0.09930398, 0.11555990, 0.14043440,
+ 0.18361420, 0.27900160, 0.70104740
+ };
+
+ double s, u, w, y, ustar, aa, tt;
+ int i;
+
+ u = uniformDistribution.random();
+ s = 0.0;
+ if (u > 0.5)
+ s = 1.0;
+ u = u + u - s;
+ u *= 32.0;
+ i = (int) u;
+ if (i == 32)
+ i = 31;
+ deliver: {
+ if (i != 0) {
+ ustar = u - i;
+ aa = a[i - 1];
+ while (ustar <= t[i - 1]) {
+ u = uniformDistribution.random();
+ w = u * (a[i] - aa);
+ tt = (w * 0.5 + aa) * w;
+ while(true) {
+ if (ustar > tt)
+ break deliver;
+ u = uniformDistribution.random();
+ if (ustar < u)
+ break;
+ tt = u;
+ ustar = uniformDistribution.random();
+ }
+ ustar = uniformDistribution.random();
+ }
+ w = (ustar - t[i - 1]) * h[i - 1];
+ }
+ else {
+ i = 6;
+ aa = a[31];
+ while(true) {
+ u = u + u;
+ if (u >= 1.0)
+ break;
+ aa = aa + d[i - 1];
+ i = i + 1;
+ }
+ u = u - 1.0;
+ jump: while(true) {
+ w = u * d[i - 1];
+ tt = (w * 0.5 + aa) * w;
+ while(true) {
+ ustar = uniformDistribution.random();
+ if (ustar > tt)
+ break jump;
+ u = uniformDistribution.random();
+ if (ustar < u)
+ break;
+ tt = u;
+ }
+ u = uniformDistribution.random();
+ } // jump:;
+ }
+
+ } // deliver:
+ y = aa + w;
+ return (s == 1.0) ? -y : y;
+
+ }
+
+ /*!* #endif /*4!*/
+
+ /*!* #ifdef KINDERMAN_RAMAGE /*4!*/
+
+ /*
+ * REFERENCE
+ *
+ * Kinderman A. J. and Ramage J. G. (1976).
+ * Computer generation of Normal random variables.
+ * JASA 71, 893-896.
+ */
+
+ static final double C1 = 0.398942280401433;
+ static final double C2 = 0.180025191068563;
+/*!* /*!* #define g(x) (C1*exp(-x*x/2.0)-C2*(a-fabs(x))) /*4!* *!*/
+ static final double a = 2.216035867166471;
+
+ static final double g(double x)
+ {
+ return (C1*java.lang.Math.exp(-x*x/2.0)-C2*(a-java.lang.Math.abs(x))) ;
+ }
+
+ public static double random( Uniform uniformDistribution )
+ {
+ double t, u1, u2, u3;
+
+ u1 = uniformDistribution.random();
+ if(u1 < 0.884070402298758) {
+ u2 = uniformDistribution.random();
+ return a*(1.13113163544180*u1+u2-1);
+ }
+
+ if(u1 >= 0.973310954173898) {
+ tail: while(true) {
+ u2 = uniformDistribution.random();
+ u3 = uniformDistribution.random();
+/*!* t = (a*a-2*log(u3)); *!*/
+ t = (a*a-2*java.lang.Math.log(u3));
+ if( u2*u2<(a*a)/t )
+/*!* return (u1 < 0.986655477086949) ? sqrt(t) : -sqrt(t) ; *!*/
+ return (u1 < 0.986655477086949) ? java.lang.Math.sqrt(t) : -java.lang.Math.sqrt(t) ;
+ // continue tail;
+ }
+ }
+
+ if(u1 >= 0.958720824790463) {
+ region3: while(true) {
+ u2 = uniformDistribution.random();
+ u3 = uniformDistribution.random();
+/*!* t = a - 0.630834801921960* fmin2(u2,u3); *!*/
+ t = a - 0.630834801921960* Math.min(u2,u3);
+/*!* if(fmax2(u2,u3) <= 0.755591531667601) *!*/
+ if(Math.max(u2,u3) <= 0.755591531667601)
+ return (u2= 0.911312780288703) {
+ region2: {
+ u2 = uniformDistribution.random();
+ u3 = uniformDistribution.random();
+/*!* t = 0.479727404222441+1.105473661022070*fmin2(u2,u3); *!*/
+ t = 0.479727404222441+1.105473661022070*Math.min(u2,u3);
+/*!* if( fmax2(u2,u3)<=0.872834976671790 ) *!*/
+ if( Math.max(u2,u3)<=0.872834976671790 )
+ return (u2 testArr[i+1] )
+// {
+// temp = testArr[i];
+// testArr[i] = testArr[i+1];
+// testArr[i+1] = temp;
+// ordered=false;
+// }
+// }
+
+// return true;
+
+// }
+
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Poisson.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Poisson.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Poisson.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Poisson.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,462 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Poisson
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double lambda)
+ *
+ * DESCRIPTION
+ *
+ * The density function of the Poisson distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double lambda)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isNaN(x) || Double.isNaN(lambda))
+ return x + lambda;
+ /*!* #endif /*4!*/
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if(lambda <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0)
+ return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x))
+ return 0;
+ /*!* #endif /*4!*/
+/*!* return exp(x * log(lambda) - lambda - lgammafn(x + 1)); *!*/
+ return java.lang.Math.exp(x * java.lang.Math.log(lambda) - lambda - Misc.lgammafn(x + 1));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double lambda)
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Poisson distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double lambda)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(lambda))
+ return x + lambda;
+ /*!* #endif /*4!*/
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if(lambda <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x < 0)
+ return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(x))
+ return 1;
+ /*!* #endif /*4!*/
+ return 1 - Gamma.cumulative(lambda, x + 1, 1.0);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double lambda)
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Poisson distribution.
+ *
+ * METHOD
+ *
+ * Uses the Cornish-Fisher Expansion to include a skewness
+ * correction to a Normal approximation. This gives an
+ * initial value which never seems to be off by more than
+ * 1 or 2. A search is then conducted of values close to
+ * this initial start point.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double lambda)
+ {
+ double mu, sigma, gamma, z, y;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(lambda))
+ return x + lambda;
+ if(Double.isInfinite(lambda)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+ if(x < 0 || x > 1 || lambda <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (x == 1) return Double.POSITIVE_INFINITY;
+ /*!* #endif /*4!*/
+ mu = lambda;
+/*!* sigma = sqrt(lambda); *!*/
+ sigma = java.lang.Math.sqrt(lambda);
+ gamma = sigma;
+ z = Normal.quantile(x, 0.0, 1.0);
+/*!* y = floor(mu + sigma * (z + Gamma * (z * z - 1) / 6) + 0.5); *!*/
+ y = java.lang.Math.floor(mu + sigma * (z + gamma * (z * z - 1) / 6) + 0.5);
+ z = cumulative(y, lambda);
+
+ if(z >= x) {
+
+ /* search to the left */
+
+ for(;;) {
+ if((z = Poisson.cumulative(y - 1, lambda)) < x)
+ return y;
+ y = y - 1;
+ }
+ }
+ else {
+
+ /* search to the right */
+
+ for(;;) {
+ if((z = Poisson.cumulative(y + 1, lambda)) >= x)
+ return y + 1;
+ y = y + 1;
+ }
+ }
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double lambda)
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Poisson distribution.
+ *
+ * REFERENCE
+ *
+ * Ahrens, J.H. and Dieter, U. (1982).
+ * Computer generation of Poisson deviates
+ * from modified Normal distributions.
+ * ACM Trans. Math. Software 8, 163-179.
+ */
+
+ /* Factorial Table */
+ static double fact[] =
+ {
+ 1.0,
+ 1.0,
+ 2.0,
+ 6.0,
+ 24.0,
+ 120.0,
+ 720.0,
+ 5040.0,
+ 40320.0,
+ 362880.0
+ };
+
+ static private double a0 = -0.5;
+ static private double a1 = 0.3333333;
+ static private double a2 = -0.2500068;
+ static private double a3 = 0.2000118;
+ static private double a4 = -0.1661269;
+ static private double a5 = 0.1421878;
+ static private double a6 = -0.1384794;
+ static private double a7 = 0.1250060;
+
+ // static private double while(true) = for(;;);
+
+ /*!* #include "DistLib.h" /*4!*/
+
+
+ static private double /* a0, a1, a2, a3, a4, a5, a6, a7, */ b1, b2;
+ static private double c, c0, c1, c2, c3, d, del, difmuk, e;
+ static private double fk, fx, fy, g, omega;
+ static private double p, p0, px, py, q, s, t, u, v, x, xx;
+ static private double pp[] = new double[36];
+ static private int j, k, kflag, l, m;
+ static private int ipois;
+ static private double muprev = 0.0;
+ static private double muold = 0.0;
+
+
+ public static double random(double mu, Uniform uniformDistribution )
+ {
+ throw new java.lang.ArithmeticException("FUNCTION NOT IMPLEMENTED");
+ }
+}
+/******
+/****** if (mu != muprev) {
+/****** if (mu >= 10.0) {
+/****** /* case a. (recalculation of s,d,l */
+/****** /* if mu has changed) */
+/****** /* the Poisson probabilities pk */
+/****** /* exceed the discrete Normal */
+/****** /* probabilities fk whenever k >= m(mu). */
+/****** /* l=ifix(mu-1.1484) is an upper bound */
+/****** /* to m(mu) for all mu >= 10. */
+/****** muprev = mu;
+/****** /*!* s = sqrt(mu); *!*/
+/****** s = java.lang.Math.sqrt(mu);
+/****** d = 6.0 * mu * mu;
+/****** l = mu - 1.1484;
+/****** } else {
+/****** /* Case B. (start new table and */
+/****** /* calculate p0 if necessary) */
+/****** muprev = 0.0;
+/****** if (mu != muold) {
+/****** muold = mu;
+/****** /*!* m = imax2(1, (int) mu); *!*/
+/****** m = Math.max(1, (int) mu);
+/****** l = 0;
+/****** /*!* p = exp(-mu); *!*/
+/****** p = java.lang.Math.exp(-mu);
+/****** q = p;
+/****** p0 = p;
+/****** }
+/****** while(true) {
+/****** /* Step U. Uniform sample */
+/****** /* for inversion method */
+/****** u = Uniform.random();
+/****** ipois = 0;
+/****** if (u <= p0)
+/****** return (double)ipois;
+/****** /* Step T. table comparison until */
+/****** /* the end pp(l) of the pp-table of */
+/****** /* cumulative Poisson probabilities */
+/****** /* (0.458=pp(9) for mu=10) */
+/****** if (l != 0) {
+/****** j = 1;
+/****** if (u > 0.458)
+/****** /*!* j = Math.min(l, m); *!*/
+/****** j = Math.min(l, m);
+/****** for (k = j; k <= l; k++)
+/****** if (u <= pp[k])
+/****** return (double)k;
+/****** if (l == 35)
+/****** continue;
+/****** }
+/****** /* Step C. creation of new Poisson */
+/****** /* probabilities p and their cumulatives */
+/****** /* q=pp[k] */
+/****** l = l + 1;
+/****** for (k = l; k <= 35; k++) {
+/****** p = p * mu / k;
+/****** q = q + p;
+/****** pp[k] = q;
+/****** if (u <= q) {
+/****** l = k;
+/****** return (double)k;
+/****** }
+/****** }
+/****** l = 35;
+/****** }
+/****** }
+/****** }
+/****** /* Step N. Normal sample */
+/****** /* Normal.random() for standard Normal deviate */
+/****** g = mu + s * Normal.random();
+/****** if (g >= 0.0) {
+/****** ipois = g;
+/****** /* Step I. immediate acceptance */
+/****** /* if ipois is large enough */
+/****** if (ipois >= l)
+/****** return (double)ipois;
+/****** /* Step S. squeeze acceptance */
+/****** /* Uniform.random() for (0,1)-sample u */
+/****** fk = ipois;
+/****** difmuk = mu - fk;
+/****** u = Uniform.random();
+/****** if (d * u >= difmuk * difmuk * difmuk)
+/****** return (double)ipois;
+/****** }
+/****** /* Step P. preparations for steps Q and H. */
+/****** /* (recalculations of parameters if necessary) */
+/****** /* 0.3989423=(2*pi)**(-0.5) */
+/****** /* 0.416667e-1=1./24. */
+/****** /* 0.1428571=1./7. */
+/****** /* The quantities b1, b2, c3, c2, c1, c0 are for the Hermite */
+/****** /* approximations to the discrete Normal probabilities fk. */
+/****** /* c=.1069/mu guarantees majorization by the 'hat'-function. */
+/****** if (mu != muold) {
+/****** muold = mu;
+/****** omega = 0.3989423 / s;
+/****** b1 = 0.4166667e-1 / mu;
+/****** b2 = 0.3 * b1 * b1;
+/****** c3 = 0.1428571 * b1 * b2;
+/****** c2 = b2 - 15. * c3;
+/****** c1 = b1 - 6. * b2 + 45. * c3;
+/****** c0 = 1. - b1 + 3. * b2 - 15. * c3;
+/****** c = 0.1069 / mu;
+/****** }
+/****** if (g >= 0.0) {
+/****** /* 'Subroutine' F is called (kflag=0 for correct return) */
+/****** kflag = 0;
+/****** goto L20;
+/****** }
+/****** else while(true) {
+/****** /* Step E. Exponential Sample */
+/****** /* exponential.random() for standard exponential deviate */
+/****** /* e and sample t from the laplace 'hat' */
+/****** /* (if t <= -0.6744 then pk < fk for all mu >= 10.) */
+/****** e = exponential.random();
+/****** u = Uniform.random();
+/****** u = u + u - 1.0;
+/****** /*!* t = 1.8 + fsign(e, u); *!*/
+/****** t = 1.8 + Misc.fsign(e, u);
+/****** if (t > -0.6744) {
+/****** ipois = mu + s * t;
+/****** fk = ipois;
+/****** difmuk = mu - fk;
+/****** f(
+/****** /* 'subroutine' f is called */
+/****** /* (kflag=1 for correct return) */
+/****** kflag = 1;
+/****** //********** subroutine_f(kflag) ************** //
+/******
+/****** }
+/****** }
+/****** return (double)ipois;
+/****** }
+/****** }
+/******
+/******double[] subroutine_f ( double px; double mu; double py; double del; double fk; double v; double a7; double a6; double a5; double a4; double a3; double a2; double a1; double a0; double x; double xx; double fx; double omega; double c3; double c2; double c1; double c0; double u; double e; int kflag )
+/****** {
+/******
+/****** /* Step f. 'subroutine' f. */
+/****** /* calculation of px,py,fx,fy. */
+/****** /* case ignpoi < 10 uses */
+/****** /* factorials from table fact */
+/****** L20:if (ipois < 10) {
+/****** px = -mu;
+/****** /*!* py = pow(mu, (double) ipois) / fact[ipois]; *!*/
+/****** py = java.lang.Math.pow(mu, (double) ipois) / fact[ipois];
+/****** } else {
+/****** /* Case ipois >= 10 uses polynomial */
+/****** /* approximation a0-a7 for accuracy */
+/****** /* when advisable */
+/****** /* 0.8333333e-1=1./12.0 */
+/****** /* 0.3989423=(2*pi)**(-0.5) */
+/****** del = 0.8333333e-1 / fk;
+/****** del = del - 4.8 * del * del * del;
+/****** v = difmuk / fk;
+/****** /*!* if (fabs(v) <= 0.25) *!*/
+/****** if (java.lang.Math.abs(v) <= 0.25)
+/****** px = fk * v * v * (((((((a7 * v + a6) * v + a5) * v + a4) * v + a3) * v + a2) * v + a1) * v + a0) - del;
+/****** else
+/****** /*!* px = fk * log(1.0 + v) - difmuk - del; *!*/
+/****** px = fk * java.lang.Math.log(1.0 + v) - difmuk - del;
+/****** /*!* py = 0.3989423 / sqrt(fk); *!*/
+/****** py = 0.3989423 / java.lang.Math.sqrt(fk);
+/****** }
+/****** x = (0.5 - difmuk) / s;
+/****** xx = x * x;
+/****** fx = -0.5 * xx;
+/****** fy = omega * (((c3 * xx + c2) * xx + c1) * xx + c0);
+/****** if (kflag > 0) {
+/****** /* Step H. hat acceptance */
+/****** /* (e is while(true)ed on rejection) */
+/****** /*!* if (c * fabs(u) <= py * exp(px + e) - fy * exp(fx + e)) *!*/
+/****** if (c * java.lang.Math.abs(u) <= py * java.lang.Math.exp(px + e) - fy * java.lang.Math.exp(fx + e))
+/****** break;
+/****** } else
+/****** /* step q. quotient acceptance (rare case) */
+/****** /*!* if (fy - u * fy <= py * exp(px - fx)) *!*/
+/****** if (fy - u * fy <= py * java.lang.Math.exp(px - fx))
+/****** break;
+/******}
+*******/
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Polygamma.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Polygamma.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Polygamma.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Polygamma.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,567 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Polygamma
+ {
+/***UNUSED*** /*
+/***UNUSED*** * DistLib : A C Library of Special Functions
+/***UNUSED*** * Copyright (C) 1998 Ross Ihaka
+/***UNUSED*** *
+/***UNUSED*** * This program is free software; you can redistribute it and/or modify
+/***UNUSED*** * it under the terms of the GNU General Public License as published by
+/***UNUSED*** * the Free Software Foundation; either version 2 of the License, or
+/***UNUSED*** * (at your option) any later version.
+/***UNUSED*** *
+/***UNUSED*** * This program is distributed in the hope that it will be useful,
+/***UNUSED*** * but WITHOUT ANY WARRANTY; without even the implied warranty of
+/***UNUSED*** * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+/***UNUSED*** * GNU General Public License for more details.
+/***UNUSED*** *
+/***UNUSED*** * You should have received a copy of the GNU General Public License
+/***UNUSED*** * along with this program; if not, write to the Free Software
+/***UNUSED*** * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+/***UNUSED*** *
+/***UNUSED*** * SYNOPSIS
+/***UNUSED*** *
+/***UNUSED*** * #include "DistLib.h"
+/***UNUSED*** * void dpsifn(double x, int n, int kode, int m,
+/***UNUSED*** * double *ans, int *nz, int *ierr)
+/***UNUSED*** * double digamma(double x);
+/***UNUSED*** * double trigamma(double x)
+/***UNUSED*** * double tetragamma(double x)
+/***UNUSED*** * double pentagamma(double x)
+/***UNUSED*** *
+/***UNUSED*** * DESCRIPTION
+/***UNUSED*** *
+/***UNUSED*** * Compute the derivatives of the psi function
+/***UNUSED*** * and Polygamma functions.
+/***UNUSED*** *
+/***UNUSED*** * The following definitions are used in dpsifn:
+/***UNUSED*** *
+/***UNUSED*** * Definition 1
+/***UNUSED*** *
+/***UNUSED*** * psi(x) = d/dx (ln(gamma(x)), the first derivative of
+/***UNUSED*** * the log gamma function.
+/***UNUSED*** *
+/***UNUSED*** * Definition 2
+/***UNUSED*** * k k
+/***UNUSED*** * psi(k,x) = d /dx (psi(x)), the k-th derivative
+/***UNUSED*** * of psi(x).
+/***UNUSED*** *
+/***UNUSED*** *
+/***UNUSED*** * "dpsifn" computes a sequence of scaled derivatives of
+/***UNUSED*** * the psi function; i.e. for fixed x and m it computes
+/***UNUSED*** * the m-member sequence
+/***UNUSED*** *
+/***UNUSED*** * ((-1)**(k+1)/gamma(k+1))*psi(k,x)
+/***UNUSED*** * for k = n,...,n+m-1
+/***UNUSED*** *
+/***UNUSED*** * where psi(k,x) is as defined above. For kode=1, dpsifn
+/***UNUSED*** * returns the scaled derivatives as described. kode=2 is
+/***UNUSED*** * operative only when k=0 and in that case dpsifn returns
+/***UNUSED*** * -psi(x) + ln(x). That is, the logarithmic behavior for
+/***UNUSED*** * large x is removed when kode=2 and k=0. When sums or
+/***UNUSED*** * differences of psi functions are computed the logarithmic
+/***UNUSED*** * terms can be combined analytically and computed separately
+/***UNUSED*** * to help retain significant digits.
+/***UNUSED*** *
+/***UNUSED*** * Note that dpsifn(x, 0, 1, 1, ans) results in ans = -psi(x).
+/***UNUSED*** *
+/***UNUSED*** * INPUT
+/***UNUSED*** *
+/***UNUSED*** * x - argument, x > 0.
+/***UNUSED*** *
+/***UNUSED*** * n - first member of the sequence, 0 <= n <= 100
+/***UNUSED*** * n == 0 gives ans(1) = -psi(x) for kode=1
+/***UNUSED*** * -psi(x)+ln(x) for kode=2
+/***UNUSED*** *
+/***UNUSED*** * kode - selection parameter
+/***UNUSED*** * kode == 1 returns scaled derivatives of the
+/***UNUSED*** * psi function.
+/***UNUSED*** * kode == 2 returns scaled derivatives of the
+/***UNUSED*** * psi function except when n=0. In this case,
+/***UNUSED*** * ans(1) = -psi(x) + ln(x) is returned.
+/***UNUSED*** *
+/***UNUSED*** * m - number of members of the sequence, m >= 1
+/***UNUSED*** *
+/***UNUSED*** * OUTPUT
+/***UNUSED*** *
+/***UNUSED*** * ans - a vector of length at least m whose first m
+/***UNUSED*** * components contain the sequence of derivatives
+/***UNUSED*** * scaled according to kode.
+/***UNUSED*** *
+/***UNUSED*** * nz - underflow flag
+/***UNUSED*** * nz == 0, a normal return
+/***UNUSED*** * nz != 0, underflow, last nz components of ans are
+/***UNUSED*** * set to zero, ans(m-k+1)=0.0, k=1,...,nz
+/***UNUSED*** *
+/***UNUSED*** * ierr - error flag
+/***UNUSED*** * ierr=0, a normal return, computation completed
+/***UNUSED*** * ierr=1, input error, no computation
+/***UNUSED*** * ierr=2, overflow, x too small or n+m-1 too
+/***UNUSED*** * large or both
+/***UNUSED*** * ierr=3, error, n too large. dimensioned
+/***UNUSED*** * array trmr(nmax) is not large enough for n
+/***UNUSED*** *
+/***UNUSED*** * The nominal computational accuracy is the maximum of unit
+/***UNUSED*** * roundoff (d1mach(4)) and 1e-18 since critical constants
+/***UNUSED*** * are given to only 18 digits.
+/***UNUSED*** *
+/***UNUSED*** * The basic method of evaluation is the asymptotic expansion
+/***UNUSED*** * for large x >= xmin followed by backward recursion on a two
+/***UNUSED*** * term recursion relation
+/***UNUSED*** *
+/***UNUSED*** * w(x+1) + x**(-n-1) = w(x).
+/***UNUSED*** *
+/***UNUSED*** * this is supplemented by a series
+/***UNUSED*** *
+/***UNUSED*** * sum( (x+k)**(-n-1) , k=0,1,2,... )
+/***UNUSED*** *
+/***UNUSED*** * which converges rapidly for large n. both xmin and the
+/***UNUSED*** * number of terms of the series are calculated from the unit
+/***UNUSED*** * roundoff of the machine environment.
+/***UNUSED*** *
+/***UNUSED*** * AUTHOR
+/***UNUSED*** *
+/***UNUSED*** * Amos, D. E. (Fortran)
+/***UNUSED*** * Ross Ihaka (C Translation)
+/***UNUSED*** *
+/***UNUSED*** * REFERENCES
+/***UNUSED*** *
+/***UNUSED*** * Handbook of Mathematical Functions,
+/***UNUSED*** * National Bureau of Standards Applied Mathematics Series 55,
+/***UNUSED*** * Edited by M. Abramowitz and I. A. Stegun, equations 6.3.5,
+/***UNUSED*** * 6.3.18, 6.4.6, 6.4.9 and 6.4.10, pp.258-260, 1964.
+/***UNUSED*** *
+/***UNUSED*** * D. E. Amos, (1983). "A Portable Fortran Subroutine for
+/***UNUSED*** * Derivatives of the Psi Function", Algorithm 610,
+/***UNUSED*** * TOMS 9(4), pp. 494-502.
+/***UNUSED*** *
+/***UNUSED*** * Routines called: d1mach, i1mach.
+/***UNUSED*** */
+/***UNUSED***
+/***UNUSED*** /*!* #include "DistLib.h" /*4!*/
+/***UNUSED***
+/***UNUSED*** /* Bernoulli Numbers */
+/***UNUSED***
+/***UNUSED*** static private double b[] = {
+/***UNUSED*** 00, /** DUMMY ENTRY SO INDEXING FROM 1 WORKS **/
+/***UNUSED*** 1.00000000000000000e+00,
+/***UNUSED*** -5.00000000000000000e-01,
+/***UNUSED*** 1.66666666666666667e-01,
+/***UNUSED*** -3.33333333333333333e-02,
+/***UNUSED*** 2.38095238095238095e-02,
+/***UNUSED*** -3.33333333333333333e-02,
+/***UNUSED*** 7.57575757575757576e-02,
+/***UNUSED*** -2.53113553113553114e-01,
+/***UNUSED*** 1.16666666666666667e+00,
+/***UNUSED*** -7.09215686274509804e+00,
+/***UNUSED*** 5.49711779448621554e+01,
+/***UNUSED*** -5.29124242424242424e+02,
+/***UNUSED*** 6.19212318840579710e+03,
+/***UNUSED*** -8.65802531135531136e+04,
+/***UNUSED*** 1.42551716666666667e+06,
+/***UNUSED*** -2.72982310678160920e+07,
+/***UNUSED*** 6.01580873900642368e+08,
+/***UNUSED*** -1.51163157670921569e+10,
+/***UNUSED*** 4.29614643061166667e+11,
+/***UNUSED*** -1.37116552050883328e+13,
+/***UNUSED*** 4.88332318973593167e+14,
+/***UNUSED*** -1.92965793419400681e+16
+/***UNUSED*** };
+/***UNUSED***
+/***UNUSED*** // static private double *b = (double *)&bvalues -1;
+/***UNUSED*** static private int nmax = 100;
+/***UNUSED***
+/***UNUSED*** public static int ierr = 0;
+/***UNUSED***
+/***UNUSED*** static double[] dpsifn(double x, int n, int kode, int m, int nz)
+/***UNUSED*** {
+/***UNUSED*** double ans[] = new double[n+1];
+/***UNUSED*** double retval[] = new double[n];
+/***UNUSED*** int i, j, k, mm, mx, nn, np, nx, fn;
+/***UNUSED*** double arg, den, elim, eps, fln, fx, rln, rxsq;
+/***UNUSED*** double r1m4, r1m5, s, slope, t, ta, tk, tol, tols, tss, tst;
+/***UNUSED*** double tt, t1, t2, wdtol, xdmln, xdmy, xinc, xln, xm, xmin;
+/***UNUSED*** double xq, yint;
+/***UNUSED*** double trm[] = new double[23], trmr[] = new double[101];
+/***UNUSED***
+/***UNUSED*** ierr = 0;
+/***UNUSED*** if (x <= 0.0 || n < 0 || kode < 1 || kode > 2 || m < 1) {
+/***UNUSED*** ierr = 1;
+/***UNUSED*** return ans;
+/***UNUSED*** }
+/***UNUSED***
+/***UNUSED*** /* fortran adjustment */
+/***UNUSED*** //ans--;
+/***UNUSED***
+/***UNUSED*** nz = 0;
+/***UNUSED*** mm = m;
+/***UNUSED*** /*!* nx = Math.min(-i1mach(15), i1mach(16)); *!*/
+/***UNUSED*** nx = Math.min(-misc.i1mach(15), misc.i1mach(16));
+/***UNUSED*** /*!* r1m5 = d1mach(5); *!*/
+/***UNUSED*** r1m5 = misc.d1mach(5);
+/***UNUSED*** /*!* r1m4 = d1mach(4) * 0.5; *!*/
+/***UNUSED*** r1m4 = misc.d1mach(4) * 0.5;
+/***UNUSED*** /*!* wdtol = fmax2(r1m4, 0.5e-18); *!*/
+/***UNUSED*** wdtol = Math.max(r1m4, 0.5e-18);
+/***UNUSED***
+/***UNUSED*** /* elim = approximate exponential over and underflow limit */
+/***UNUSED***
+/***UNUSED*** elim = 2.302 * (nx * r1m5 - 3.0);
+/***UNUSED*** /*!* xln = log(x); *!*/
+/***UNUSED*** xln = java.lang.Math.log(x);
+/***UNUSED*** for(;;) {
+/***UNUSED*** nn = n + mm - 1;
+/***UNUSED*** fn = nn;
+/***UNUSED*** t = (fn + 1) * xln;
+/***UNUSED***
+/***UNUSED*** /* overflow and underflow test for small and large x */
+/***UNUSED***
+/***UNUSED*** /*!* if (fabs(t) > elim) { *!*/
+/***UNUSED*** if (java.lang.Math.abs(t) > elim) {
+/***UNUSED*** if (t <= 0.0) {
+/***UNUSED*** nz = 0;
+/***UNUSED*** ierr = 2;
+/***UNUSED*** {
+/***UNUSED*** for(int count=0; count 7.0 && fln < 15.0)
+/***UNUSED*** break;
+/***UNUSED*** }
+/***UNUSED*** xdmy = x;
+/***UNUSED*** xdmln = xln;
+/***UNUSED*** xinc = 0.0;
+/***UNUSED*** if (x < xmin) {
+/***UNUSED*** nx = (int)x;
+/***UNUSED*** xinc = xmin - nx;
+/***UNUSED*** xdmy = x + xinc;
+/***UNUSED*** /*!* xdmln = log(xdmy); *!*/
+/***UNUSED*** xdmln = java.lang.Math.log(xdmy);
+/***UNUSED*** }
+/***UNUSED***
+/***UNUSED*** /* generate w(n+mm-1, x) by the asymptotic expansion */
+/***UNUSED***
+/***UNUSED*** t = fn * xdmln;
+/***UNUSED*** t1 = xdmln + xdmln;
+/***UNUSED*** t2 = t + xdmln;
+/***UNUSED*** /*!* tk = fmax2(fabs(t), fmax2(fabs(t1), fabs(t2))); *!*/
+/***UNUSED*** tk = Math.max(java.lang.Math.abs(t), Math.max(java.lang.Math.abs(t1), java.lang.Math.abs(t2)));
+/***UNUSED*** if (tk <= elim)
+/***UNUSED*** break L10;
+/***UNUSED*** }
+/***UNUSED***
+/***UNUSED*** nz = nz + 1;
+/***UNUSED*** ans[mm] = 0.0;
+/***UNUSED*** mm = mm - 1;
+/***UNUSED*** if (mm == 0)
+/***UNUSED*** {
+/***UNUSED*** for(int count=0; count n */
+/***UNUSED***
+/***UNUSED*** tol = wdtol / 5.0;
+/***UNUSED*** for(j=2 ; j<=mm ; j++) {
+/***UNUSED*** t = t / x;
+/***UNUSED*** s = t;
+/***UNUSED*** tols = t * tol;
+/***UNUSED*** den = x;
+/***UNUSED*** for(i=1 ; i<=nn ; i++) {
+/***UNUSED*** den = den + 1.0;
+/***UNUSED*** trm[i] = trm[i] / den;
+/***UNUSED*** s = s + trm[i];
+/***UNUSED*** if (trm[i] < tols)
+/***UNUSED*** break;
+/***UNUSED*** }
+/***UNUSED*** ans[j] = s;
+/***UNUSED*** }
+/***UNUSED*** }
+/***UNUSED*** {
+/***UNUSED*** for(int count=0; count= tst) { *!*/
+/***UNUSED*** if (java.lang.Math.abs(s) >= tst) {
+/***UNUSED*** tk = 2.0;
+/***UNUSED*** for(k=4 ; k<=22 ; k++) {
+/***UNUSED*** t = t * ((tk + fn + 1)/(tk + 1.0))*((tk + fn)/(tk + 2.0)) * rxsq;
+/***UNUSED*** trm[k] = t * b[k];
+/***UNUSED*** /*!* if (fabs(trm[k]) < tst) *!*/
+/***UNUSED*** if (java.lang.Math.abs(trm[k]) < tst)
+/***UNUSED*** break;
+/***UNUSED*** s = s + trm[k];
+/***UNUSED*** tk = tk + 2.0;
+/***UNUSED*** }
+/***UNUSED*** }
+/***UNUSED*** s = (s + t1) * tss;
+/***UNUSED*** if (xinc != 0.0) {
+/***UNUSED***
+/***UNUSED*** /* backward recur from xdmy to x */
+/***UNUSED***
+/***UNUSED*** nx = (int)xinc;
+/***UNUSED*** np = nn + 1;
+/***UNUSED*** if (nx > nmax) {
+/***UNUSED*** nz = 0;
+/***UNUSED*** ierr = 3;
+/***UNUSED*** {
+/***UNUSED*** for(int count=0; count= tst) { *!*/
+/***UNUSED*** if (java.lang.Math.abs(s) >= tst) {
+/***UNUSED*** tk = 4 + fn;
+/***UNUSED*** for(k=4 ; k<=22 ; k++) {
+/***UNUSED*** trm[k] = trm[k] * (fn + 1) / tk;
+/***UNUSED*** /*!* if (fabs(trm[k]) < tst) *!*/
+/***UNUSED*** if (java.lang.Math.abs(trm[k]) < tst)
+/***UNUSED*** break;
+/***UNUSED*** s = s + trm[k];
+/***UNUSED*** tk = tk + 2.0;
+/***UNUSED*** }
+/***UNUSED*** }
+/***UNUSED*** s = (s + t1) * tss;
+/***UNUSED***
+/***UNUSED*** if (xinc != 0.0) {
+/***UNUSED*** if (fn == 0)
+/***UNUSED*** break L20;
+/***UNUSED*** xm = xinc - 1.0;
+/***UNUSED*** fx = x + xm;
+/***UNUSED*** for(i=1 ; i<=nx ; i++) {
+/***UNUSED*** trmr[i] = trmr[i] * fx;
+/***UNUSED*** s = s + trmr[i];
+/***UNUSED*** xm = xm - 1.0;
+/***UNUSED*** fx = x + xm;
+/***UNUSED*** }
+/***UNUSED*** }
+/***UNUSED*** mx = mm - j + 1;
+/***UNUSED*** ans[mx] = s;
+/***UNUSED*** if (fn == 0)
+/***UNUSED*** break L30;
+/***UNUSED*** }
+/***UNUSED*** {
+/***UNUSED*** for(int count=0; count>16);
+ i_seed[0]= 18000*(i_seed[0] & 0177777) + (i_seed[0]>>16);
+ return (do32bits(i1_seed << 16) ^ (i_seed[0] & 0177777)) * i2_32m1; /* in [0,1) */
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/Rand.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/Rand.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/Rand.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/Rand.java 2010-01-15 06:08:51.000000000 +0000
@@ -0,0 +1,27 @@
+/*
+ * Created on Apr 17, 2007
+ */
+package org.mathpiper.builtin.library.statdistlib.rng;
+
+import java.util.Random;
+
+import org.mathpiper.builtin.library.statdistlib.StdUniformRng;
+
+
+public class Rand implements StdUniformRng {
+
+ Random random;
+
+ public Rand() {
+ random = new Random();
+ }
+
+ public void fixupSeeds() {
+ ; // do nothing since seeds are managed
+ }
+
+ public double random() {
+ return random.nextDouble();
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/SuperDuper.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/SuperDuper.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/SuperDuper.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/SuperDuper.java 2010-01-15 06:08:51.000000000 +0000
@@ -0,0 +1,42 @@
+/**
+ * Standard random deviates via
+ * Reeds et al (1984) implementation;
+ * modified using __unsigned__ seeds instead of signed ones.
+ *
+ * Created on Apr 17, 2007
+ */
+package org.mathpiper.builtin.library.statdistlib.rng;
+
+import org.mathpiper.builtin.library.statdistlib.StdUniformRng;
+
+
+public class SuperDuper implements StdUniformRng {
+
+ private int i1_seed;
+ private int[] i_seed;
+
+ static private double i2_32m1 = 2.328306437080797e-10; /* = 1/(2^32 - 1) */
+ static private int do32bits(int N) { return (N); }
+
+ public SuperDuper() {
+ i1_seed = 123;
+ i_seed = new int[1];
+ fixupSeeds();
+ }
+ public void fixupSeeds() {
+ if (i1_seed==0) i1_seed++;
+ for(int j=0; j < i_seed.length; j++) {
+ if (i_seed[j]==0) i_seed[j]++;
+ }
+ i_seed[0] |= 1; // seed must be odd
+ }
+
+ public double random() {
+ i1_seed ^= ((i1_seed >> 15) & 0377777); /* Tausworthe */
+ i1_seed ^= do32bits(i1_seed << 17);
+ i_seed[0] *= 69069; /* Congruential */
+ i_seed[0] = do32bits(69069 * i_seed[0]);
+ return (i1_seed^i_seed[0]) * i2_32m1;/* in [0,1) */
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/WichmannHill.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/WichmannHill.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/rng/WichmannHill.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/rng/WichmannHill.java 2010-01-15 06:08:51.000000000 +0000
@@ -0,0 +1,54 @@
+/**
+ * Wichmann-Hill algorithm for random variates from the
+ * standard uniform distribution, U(0,1).
+ *
+ * Wichmann, B. A. and I. D. Hill (1982).
+ * Algorithm AS 183: An efficient and portable
+ * pseudo-random number generator,
+ * Applied Statistics, 31, 188.
+ *
+ * Created on Apr 16, 2007
+ */
+package org.mathpiper.builtin.library.statdistlib.rng;
+
+import org.mathpiper.builtin.library.statdistlib.StdUniformRng;
+
+public class WichmannHill implements StdUniformRng {
+
+ int i1_seed;
+ int[] i_seed;
+ static final int c0 = 30269;
+ static final int c1 = 30307;
+ static final int c2 = 30323;
+
+ public WichmannHill() {
+ i1_seed = 123;
+ i_seed = new int[2];
+ fixupSeeds();
+ }
+
+ public void fixupSeeds() {
+ // exclude 0 as seed
+ if (i1_seed==0) i1_seed++;
+ for (int j=0; j < i_seed.length; j++) {
+ if (i_seed[j]==0) i_seed[j]++;
+ }
+ if (i1_seed >= c0 ||
+ i_seed[0] >= c1 ||
+ i_seed[1] >= c2) {
+ random();
+ }
+ }
+
+ public double random() {
+ i1_seed = i1_seed * 171 % c0;
+ i_seed[0] = i_seed[0] * 172 % c1;
+ i_seed[1] = i_seed[1] * 170 % c2;
+ double value =
+ (double)i1_seed / c0 +
+ (double)i_seed[0] / c1 +
+ (double)i_seed[1] / c2;
+ return value - (int) value; // ensure in range [0,1)
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/SignRank.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/SignRank.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/SignRank.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/SignRank.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,278 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class SignRank
+ {
+
+
+ public static final double SIGNRANK_NMAX = 50;
+
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n)
+ *
+ * DESCRIPTION
+ *
+ * The density of the Wilcoxon Signed Rank distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static private double w[][];
+
+ static private double csignrank(int k, int n) {
+ int c, u, i;
+
+ u = n * (n + 1) / 2;
+ c = (int) (u / 2);
+
+ if ((k < 0) || (k > u))
+ return(0);
+ if (k > c)
+ k = u - k;
+ if (w[n] == null) {
+ w[n] = new double[c + 1];
+ for (i = 0; i <= c; i++)
+ w[n][i] = -1;
+ }
+ if (w[n][k] < 0) {
+ if (n == 0)
+ w[n][k] = (k == 0)?1.0:0.0;
+ else
+ w[n][k] = csignrank(k - n, n - 1) + csignrank(k, n - 1);
+ }
+ return(w[n][k]);
+ }
+
+ public static double density(double x, double n) {
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(x) || Double.isNaN(n)) return x + n;
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ } else if (n >= SIGNRANK_NMAX) {
+ System.out.println("n should be less than %d\n"+ SIGNRANK_NMAX);
+ return Double.NaN;
+ }
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if ((x < 0) || (x > (n * (n + 1) / 2)))
+ return 0;
+/*!* return(exp(log(csignrank(x, n)) - n * log(2))); *!*/
+ return(java.lang.Math.exp(
+ java.lang.Math.log(
+ csignrank((int) x, (int) n)) - n * java.lang.Math.log(2)));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double n)
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Wilcoxon Signed Rank distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n) {
+ int i;
+ double p = 0.0;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n))
+ return x + n;
+ if (Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ } else if (n >= SIGNRANK_NMAX) {
+ System.out.println("n should be less than %d\n"+ SIGNRANK_NMAX);
+ return Double.NaN;
+ }
+/*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if (x < 0.0)
+ return 0;
+ if (x >= n * (n + 1) / 2)
+ return 1;
+ for (i = 0; i <= x; i++)
+ p += density(i, n);
+ return(p);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double n);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Wilcoxon Signed Rank distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double n)
+ {
+ double p, q;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n))
+ return x + n;
+ if(Double.isInfinite(x) || Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (x < 0 || x > 1 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ } else if (n >= SIGNRANK_NMAX) {
+ System.out.println("n should be less than %d\n"+ SIGNRANK_NMAX);
+ return Double.NaN;
+ }
+
+ if (x == 0) return(0.0);
+ if (x == 1) return(n * (n + 1) / 2);
+ p = 0.0;
+ q = 0.0;
+ for (;;) {
+ /* Don't call cumulative() for efficiency */
+ p += density(q, n);
+ if (p >= x)
+ return(q);
+ q++;
+ }
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double random(double n)
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Wilcoxon Signed Rank distribution.
+ *
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double n)
+ {
+ int i, k;
+ double r;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(n)) return(n);
+ /*!* #endif /*4!*/
+/*!* n = floor(n + 0.5); *!*/
+ n = java.lang.Math.floor(n + 0.5);
+ if (n < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (n == 0)
+ return(0);
+ r = 0.0;
+ k = (int) n;
+ for (i = 0; i < k; ) {
+/*!* r += (++i) * floor(sunif() + 0.5); *!*/
+ r += (++i) * java.lang.Math.floor(Uniform.random() + 0.5);
+ }
+ return(r);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/StdUniformRng.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/StdUniformRng.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/StdUniformRng.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/StdUniformRng.java 2010-01-27 09:33:28.000000000 +0000
@@ -0,0 +1,11 @@
+/**
+ * Interface for standard uniform random number generator in this package.
+ *
+ * Created on Apr 16, 2007
+ */
+package org.mathpiper.builtin.library.statdistlib;
+
+public interface StdUniformRng {
+ public void fixupSeeds();
+ public double random();
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/t.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/t.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/t.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/t.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,269 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class t
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double n);
+ *
+ * DESCRIPTION
+ *
+ * The density of the "Student" t distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double n)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n))
+ return x + n;
+ /*!* #endif /*4!*/
+ if (n <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x))
+ return 0;
+ if(Double.isInfinite(n))
+ return Normal.density(x, 0.0, 1.0);
+ /*!* #endif /*4!*/
+/*!* return pow(1.0 + x * x / n, -0.5 * (n + 1.0)) *!*/
+ return java.lang.Math.pow(1.0 + x * x / n, -0.5 * (n + 1.0))
+/*!* / (sqrt(n) * Beta(0.5, 0.5 * n)); *!*/
+ / (java.lang.Math.sqrt(n) * Misc.beta(0.5, 0.5 * n));
+ }
+ /*
+ * R : A Computer Langage for Statistical Data Analysis
+ * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double n)
+ {
+ double val;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(n))
+ return x + n;
+ /*!* #endif /*4!*/
+ if (n <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #ifdef IEEE_754 /*4!*/
+ if(Double.isInfinite(x))
+ return (x < 0) ? 0 : 1;
+ if(Double.isInfinite(n))
+ return Normal.cumulative(x, 0.0, 1.0);
+ /*!* #endif /*4!*/
+ val = 0.5 * Beta.cumulative(n / (n + x * x), n / 2.0, 0.5);
+ return (x > 0.0) ? 1 - val : val;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double p, double ndf);
+ *
+ * DESCRIPTION
+ *
+ * The "Student" t distribution quantile function.
+ *
+ * NOTES
+ *
+ * This is a C translation of the Fortran routine given in:
+ * Algorithm 396: Student's t-quantiles by G.W. Hill
+ * CACM 13(10), 619-620, October 1970
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ static private double eps = 1.e-12;
+
+ public static double quantile(double p, double ndf)
+ {
+ double a, b, c, d, prob, P, q, x, y;
+ boolean neg;
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(p) || Double.isNaN(ndf))
+ return p + ndf;
+ if(ndf < 1 || p > 1 || p < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (p == 0) return Double.NEGATIVE_INFINITY;
+ if (p == 1) return Double.POSITIVE_INFINITY;
+ /*!* #else /*4!*/
+ if (ndf < 1 || p > 1 || p < 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+ if (ndf > 1e20) return Normal.quantile(p, 0.0, 1.0);
+
+ if(p > 0.5) {
+ neg = false; P = 2 * (1 - p);
+ } else {
+ neg = true; P = 2 * p;
+ }
+
+/*!* if (fabs(ndf - 2) < eps) { *!*/
+ if (java.lang.Math.abs(ndf - 2) < eps) {
+ /* df ~= 2 */
+/*!* q = sqrt(2 / (P * (2 - P)) - 2); *!*/
+ q = java.lang.Math.sqrt(2 / (P * (2 - P)) - 2);
+ }
+ else if (ndf < 1 + eps) {
+ /* df ~= 1 */
+ prob = P * Constants.M_PI_half;
+/*!* q = cos(prob) / sin(prob); *!*/
+ q = java.lang.Math.cos(prob) / java.lang.Math.sin(prob);
+ }
+ else {
+ /*-- usual case; including, e.g., df = 1.1 */
+ a = 1 / (ndf - 0.5);
+ b = 48 / (a * a);
+ c = ((20700 * a / b - 98) * a - 16) * a + 96.36;
+/*!* d = ((94.5 / (b + c) - 3) / b + 1) * sqrt(a * Constants.M_PI_half) * ndf; *!*/
+ d = ((94.5 / (b + c) - 3) / b + 1) * java.lang.Math.sqrt(a * Constants.M_PI_half) * ndf;
+/*!* y = pow(d * P, 2 / ndf); *!*/
+ y = java.lang.Math.pow(d * P, 2 / ndf);
+
+ if (y > 0.05 + a) {
+ /* Asymptotic inverse expansion about Normal */
+ x = Normal.quantile(0.5 * P, 0.0, 1.0);
+ y = x * x;
+ if (ndf < 5)
+ c = c + 0.3 * (ndf - 4.5) * (x + 0.6);
+ c = (((0.05 * d * x - 5) * x - 7) * x - 2) * x + b + c;
+ y = (((((0.4 * y + 6.3) * y + 36) * y + 94.5) / c - y - 3) / b + 1) * x;
+ y = a * y * y;
+ if (y > 0.002)
+/*!* y = exp(y) - 1; *!*/
+ y = java.lang.Math.exp(y) - 1;
+ else {
+ /* Taylor of e^y -1 : */
+ y = 0.5 * y * y + y;
+ }
+ } else {
+ y = ((1 / (((ndf + 6) / (ndf * y) - 0.089 * d - 0.822)
+ * (ndf + 2) * 3) + 0.5 / (ndf + 4))
+ * y - 1) * (ndf + 1) / (ndf + 2) + 1 / y;
+ }
+/*!* q = sqrt(ndf * y); *!*/
+ q = java.lang.Math.sqrt(ndf * y);
+ }
+ if(neg) q = -q;
+ return q;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "mathlib.h"
+ * double random(double df);
+ *
+ * DESCRIPTION
+ *
+ * Pseudo-random variates from an F distribution.
+ *
+ * NOTES
+ *
+ * This function calls rchisq and rnorm to do the real work.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double df, Uniform uniformDistribution)
+ {
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isNaN(df) ||
+ /*!* #endif /*4!*/
+ df <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if(Double.isInfinite(df))
+ return Normal.random(uniformDistribution);
+ else
+/*!* return Normal.random!!!COMMENT!!!() / sqrt(rchisq(df) / df); *!*/
+ return Normal.random(uniformDistribution) / java.lang.Math.sqrt(Chisquare.random(df, uniformDistribution) / df);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Tukey.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Tukey.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Tukey.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Tukey.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,558 @@
+/* DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+package org.mathpiper.builtin.library.statdistlib;
+
+//import org.apache.commons.math.MathException;
+//import org.apache.commons.math.special.Erf;
+
+import org.mathpiper.builtin.library.cern.Probability;
+
+/**
+ * Distribution of the maximum of rr studentized
+ * ranges, each based on cc means and with df degrees of freedom
+ * for the standard error, is less than q.
+ *
+ * The algorithm is based on:
+ * Copenhaver, Margaret Diponzio & Holland, Burt S.
+ * Multiple comparisons of simple effects in
+ * the two-way analysis of variance with fixed effects.
+ * Journal of Statistical Computation and Simulation,
+ * Vol.30, pp.1-15, 1988.
+ */
+
+public class Tukey {
+
+ /*
+ * This function calculates probability integral of Hartley's
+ * form of the range.
+ *
+ * w = value of range
+ * rr = no. of rows or groups
+ * cc = no. of columns or treatments
+ * ir = error flag = 1 if wprob probability > 1
+ * wprob = returned probability integral from (0, w)
+ *
+ * program will not terminate if ir is raised.
+ *
+ * bb = upper limit of legendre integration
+ * eps = maximum acceptable value of integral
+ * nleg = order of legendre quadrature
+ * ihalf = int ((nleg + 1) / 2)
+ * wlar = value of range above which wincr1 intervals are used to
+ * calculate second part of integral,
+ * else wincr2 intervals are used.
+ * eps1, eps2, eps3 = values which are used as cutoffs for terminating
+ * or modifying a calculation.
+ *
+ * M_1_SQRT_2PI = 1 / sqrt(2 * pi); from abramowitz & stegun, p. 3.
+ * M_SQRT_2 = sqrt(2)
+ * xleg = legendre 12-point nodes
+ * aleg = legendre 12-point coefficients
+ */
+
+ static final double nleg = 12;
+ static final double ihalf = 6;
+
+ static double wprob(double w, double rr, double cc) throws ArithmeticException { //MathException {
+ final double eps = 1.0;
+ final double eps1 = -30.0;
+ final double eps2 = -50.0;
+ final double eps3 = 60.0;
+ final double bb = 8.0;
+ final double wlar = 3.0;
+ final double wincr1 = 2.0;
+ final double wincr2 = 3.0;
+ final double xleg[] = {
+ 0.981560634246719250690549090149e0,
+ 0.904117256370474856678465866119e0,
+ 0.769902674194304687036893833213e0,
+ 0.587317954286617447296702418941e0,
+ 0.367831498998180193752691536644e0,
+ 0.125233408511468915472441369464e0
+ };
+ final double aleg[] = {
+ 0.047175336386511827194615961485,
+ 0.106939325995318430960254718194,
+ 0.160078328543346226334652529543,
+ 0.203167426723065921749064455810,
+ 0.233492536538354808760849898925,
+ 0.249147045813402785000562436043
+ };
+ double a, ac, ans, b, binc, blb, bub, c, cc1, einsum, elsum,
+ pminus, pplus, qexpo, qsqz, rinsum, wi, wincr, xx;
+ int j, jj;
+
+ qsqz = w * 0.5;
+
+ /* if w >= 16 then the integral lower bound (occurs for c=20) */
+ /* is 0.99999999999995 so return a value of 1. */
+
+ ans = 1.0;
+ if (qsqz >= bb) return 1.0;
+
+ /* find (f(w/2) - 1) ** cc */
+ /* (first term in integral of hartley's form). */
+
+ /* if ans ** cc < 2e-22 then set ans = 0 */
+
+ ans = Probability.errorFunction(qsqz / Constants.M_SQRT_2);
+ if (ans >= Math.exp(eps2 / cc)) ans = Math.pow(ans, cc);
+ else ans = 0.0;
+
+ /* if w is large then the second component of the */
+ /* integral is small, so fewer intervals are needed. */
+
+ if (w > wlar) wincr = wincr1;
+ else wincr = wincr2;
+
+ /* find the integral of second term of hartley's form */
+ /* for the integral of the range for equal-length */
+ /* intervals using legendre quadrature. limits of */
+ /* integration are from (w/2, 8). two or three */
+ /* equal-length intervals are used. */
+
+ /* blb and bub are lower and upper limits of integration. */
+
+ blb = qsqz;
+ binc = (bb - qsqz) / wincr;
+ bub = blb + binc;
+ einsum = 0.0;
+
+ /* integrate over each interval */
+
+ cc1 = cc - 1.0;
+ for (wi = 1; wi <= wincr; wi++) {
+ elsum = 0.0;
+ a = 0.5 * (bub + blb);
+
+ /* legendre quadrature with order = nleg */
+
+ b = 0.5 * (bub - blb);
+
+ for (jj = 1; jj <= nleg; jj++) {
+ if (ihalf < jj) {
+ j = (int) (nleg - jj) + 1;
+ xx = xleg[j-1];
+ } else {
+ j = jj;
+ xx = -xleg[j-1];
+ }
+ c = b * xx;
+ ac = a + c;
+
+ /* if exp(-qexpo/2) < 9e-14, */
+ /* then doesn't contribute to integral */
+
+ qexpo = ac * ac;
+
+ if (qexpo > eps3) break;
+ if (ac > 0.0)
+ pplus = 1.0 + Probability.errorFunction(ac / Constants.M_SQRT_2);
+ else
+ pplus = 1.0 - Probability.errorFunction(-(ac / Constants.M_SQRT_2));
+
+ if (ac > w)
+ pminus = 1.0 + Probability.errorFunction((ac / Constants.M_SQRT_2) - (w / Constants.M_SQRT_2));
+ else
+ pminus = 1.0 - Probability.errorFunction((w / Constants.M_SQRT_2) - (ac / Constants.M_SQRT_2));
+
+ /* if rinsum ** (cc-1) < 9e-14, */
+ /* then doesn't contribute to integral */
+
+ rinsum = (pplus * 0.5) - (pminus * 0.5);
+ if (rinsum >= java.lang.Math.exp(eps1 / cc1)) {
+ rinsum = (aleg[j-1] * Math.exp(-(0.5 * qexpo)))
+ * Math.pow(rinsum, cc1);
+ elsum = elsum + rinsum;
+ }
+ }
+ elsum = (((2.0 * b) * cc) * Constants.M_1_SQRT_2PI) * elsum;
+ einsum = einsum + elsum;
+ blb = bub;
+ bub = bub + binc;
+ }
+
+ // if ans ** rr < 9e-14, then return 0.0
+ ans = einsum + ans;
+ if (ans <= Math.exp(eps1 / rr)) return 0.0;
+
+ ans = Math.pow(ans, rr);
+ if (ans >= eps) ans = 1.0;
+ return ans;
+ }
+
+ /**
+ * function qprob
+ *
+ * q = value of studentized range
+ * rr = no. of rows or groups
+ * cc = no. of columns or treatments
+ * df = degrees of freedom of error term
+ * ir[0] = error flag = 1 if wprob probability > 1
+ * ir[1] = error flag = 1 if qprob probability > 1
+ *
+ * qprob = returned probability integral over [0, q]
+ *
+ * The program will not terminate if ir[0] or ir[1] are raised.
+ *
+ * All references in wprob to Abramowitz and Stegun
+ * are from the following reference:
+ *
+ * Abramowitz, Milton and Stegun, Irene A.
+ * Handbook of Mathematical Functions.
+ * New York: Dover publications, Inc. (1970).
+ *
+ * All constants taken from this text are
+ * given to 25 significant digits.
+ *
+ * nlegq = order of legendre quadrature
+ * ihalfq = int ((nlegq + 1) / 2)
+ * eps = max. allowable value of integral
+ * eps1 & eps2 = values below which there is
+ * no contribution to integral.
+ *
+ * d.f. <= dhaf: integral is divided into ulen1 length intervals. else
+ * d.f. <= dquar: integral is divided into ulen2 length intervals. else
+ * d.f. <= deigh: integral is divided into ulen3 length intervals. else
+ * d.f. <= dlarg: integral is divided into ulen4 length intervals.
+ *
+ * d.f. > dlarg: the range is used to calculate integral.
+ *
+ * M_LN_2 = log(2)
+ *
+ * xlegq = legendre 16-point nodes
+ *
+ * alegq = legendre 16-point coefficients
+ *
+ * The coefficients and nodes for the legendre quadrature used in
+ * qprob and wprob were calculated using the algorithms found in:
+ *
+ * Stroud, A. H. and Secrest, D.
+ * Gaussian Quadrature Formulas.
+ * Englewood Cliffs,
+ * New Jersey: Prentice-Hall, Inc, 1966.
+ *
+ * All values matched the tables (provided in same reference)
+ * to 30 significant digits.
+ *
+ * f(x) = .5 + erf(x / sqrt(2)) / 2 for x > 0
+ *
+ * f(x) = erfc( -x / sqrt(2)) / 2 for x < 0
+ *
+ * where f(x) is standard normal c. d. f.
+ *
+ * if degrees of freedom large, approximate integral
+ * with range distribution.
+ */
+
+ static final double nlegq = 16;
+ static final double ihalfq = 8;
+
+ public static double cumulative(double q, double rr, double cc, double df) {
+ final double eps = 1.0e0;
+ final double eps1 = -30.0e0;
+ final double eps2 = 1.0e-14;
+ final double dhaf = 100.0e0;
+ final double dquar = 800.0e0;
+ final double deigh = 5000.0e0;
+ final double dlarg = 25000.0e0;
+ final double ulen1 = 1.0e0;
+ final double ulen2 = 0.5e0;
+ final double ulen3 = 0.25e0;
+ final double ulen4 = 0.125e0;
+ final double xlegq[] = {
+ 0.989400934991649932596154173450e+00,
+ 0.944575023073232576077988415535e+00,
+ 0.865631202387831743880467897712e+00,
+ 0.755404408355003033895101194847e+00,
+ 0.617876244402643748446671764049e+00,
+ 0.458016777657227386342419442984e+00,
+ 0.281603550779258913230460501460e+00,
+ 0.950125098376374401853193354250e-01
+ };
+ final double alegq[] = {
+ 0.271524594117540948517805724560e-01,
+ 0.622535239386478928628438369944e-01,
+ 0.951585116824927848099251076022e-01,
+ 0.124628971255533872052476282192e+00,
+ 0.149595988816576732081501730547e+00,
+ 0.169156519395002538189312079030e+00,
+ 0.182603415044923588866763667969e+00,
+ 0.189450610455068496285396723208e+00
+ };
+ double ans, f2, f21, f2lf, ff4, otsum, qsqz, rotsum,
+ t1, twa1, ulen, wprb;
+ int i, j, jj;
+
+ if (Double.isNaN(q) || Double.isNaN(rr) || Double.isNaN(cc) || Double.isNaN(df)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (q <= 0) return 0;
+
+ /* df must be > 1 */
+ /* there must be at least two values */
+
+ if (df < 2 || rr < 1 || cc < 2) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ if (Double.isInfinite(q)) return 1;
+
+ if (df > dlarg) {
+ try {
+ ans = wprob(q, rr, cc);
+ } catch (ArithmeticException me) { //Catch MathException.
+ throw new ArithmeticException("Doesn't converge.");
+ }
+ return ans;
+ }
+
+ /* calculate leading constant */
+ /* lgamma is the log gamma function. */
+
+ f2 = df * 0.5;
+ f2lf = ((f2 * Math.log(df)) - (df * Constants.M_LN_2)) - Misc.lgammafn(f2);
+ f21 = f2 - 1.0;
+
+ /* integral is divided into unit, half-unit, quarter-unit, or */
+ /* eighth-unit length intervals depending on the value of the */
+ /* degrees of freedom. */
+
+ ff4 = df * 0.25;
+ if (df <= dhaf) {
+ ulen = ulen1;
+ } else if (df <= dquar) {
+ ulen = ulen2;
+ } else if (df <= deigh) {
+ ulen = ulen3;
+ } else {
+ ulen = ulen4;
+ }
+
+ f2lf = f2lf + Math.log(ulen);
+
+ // integrate over each subinterval
+ ans = 0.0;
+
+ L400: {
+ for (i = 1; i <= 50; i++) {
+ otsum = 0.0;
+
+ /* legendre quadrature with order = nlegq */
+ /* nodes (stored in xlegq) are symmetric around zero. */
+
+ twa1 = ((2.0 * i) - 1.0) * ulen;
+
+ for (jj = 1; jj <= nlegq; jj++) {
+ if (ihalfq < jj) {
+ j = (int) (jj - ihalfq - 1);
+ t1 = (f2lf + (f21 * java.lang.Math.log(twa1 + (xlegq[j] * ulen))))
+ - (((xlegq[j] * ulen) + twa1) * ff4);
+ } else {
+ j = jj - 1;
+ t1 = (f2lf + (f21 * java.lang.Math.log(twa1 - (xlegq[j] * ulen))))
+ + (((xlegq[j] * ulen) - twa1) * ff4);
+
+ }
+
+ /* if exp(t1) < 9e-14, then doesn't */
+ /* contribute to integral */
+
+ if (t1 >= eps1) {
+ if (ihalfq < jj) {
+ qsqz = q * java.lang.Math.sqrt(((xlegq[j] * ulen) + twa1) * 0.5);
+ } else {
+ qsqz = q * java.lang.Math.sqrt(((-(xlegq[j] * ulen)) + twa1) * 0.5);
+ }
+
+ /* call wprob to find integral */
+ /* of range portion */
+
+ try {
+ wprb = wprob(qsqz, rr, cc);
+ } catch (ArithmeticException e) { //Catch ArithmeticException.
+ throw new ArithmeticException("Doesn't converge");
+ }
+ rotsum = (wprb * alegq[j]) * Math.exp(t1);
+ otsum = rotsum + otsum;
+ }
+ /* end legendre integral for interval i */
+ /* L200: */
+ }
+
+ /* if integral for interval i < 1e-14, */
+ /* then stop. however, in order to avoid */
+ /* small area under left tail, at least */
+ /* 1 / ulen intervals are calculated. */
+
+ if (i * ulen >= 1.0 && otsum <= eps2)
+ break L400;
+
+ /* end of interval i */
+ /* L330: */
+
+ ans = ans + otsum;
+ }
+ } //L400:
+
+ if (ans > eps) ans = 1.0;
+ return ans;
+ }
+
+ /**
+ * this function finds percentage point of the studentized range
+ * which is used as initial estimate for the secant method.
+ * function is adapted from portion of algorithm as 70
+ * from applied statistics (1974) ,vol. 23, no. 1
+ * by odeh, r. e. and evans, j. o.
+ *
+ * @param p percentage point
+ * @param c no. of columns or treatments
+ * @param v degrees of freedom
+ * @return initial estimate
+ */
+
+ static double qinv(double p, double c, double v) {
+ final double p0 = 0.322232421088;
+ final double q0 = 0.993484626060e-01;
+ final double p1 = -1.0;
+ final double q1 = 0.588581570495;
+ final double p2 = -0.342242088547;
+ final double q2 = 0.531103462366;
+ final double p3 = -0.204231210125;
+ final double q3 = 0.103537752850;
+ final double p4 = -0.453642210148e-04;
+ final double q4 = 0.38560700634e-02;
+ final double c1 = 0.8832;
+ final double c2 = 0.2368;
+ final double c3 = 1.214;
+ final double c4 = 1.208;
+ final double c5 = 1.4142;
+ final double vmax = 120.0; // cutoff above which degrees of freedom are treated as infinite
+ double ps, q, t, yi;
+
+ ps = 0.5 - 0.5 * p;
+ yi = Math.sqrt (Math.log (1.0 / (ps * ps)));
+ t = yi + (((( yi * p4 + p3) * yi + p2) * yi + p1) * yi + p0)
+ / (((( yi * q4 + q3) * yi + q2) * yi + q1) * yi + q0);
+ if (v < vmax) t += (t * t * t + t) / v / 4.0;
+ q = c1 - c2 * t;
+ if (v < vmax) q += -c3 / v + c4 * t / v;
+ return t * (q * Math.log (c - 1.0) + c5);
+ }
+
+ /**
+ * Computes the quantiles of the maximum of rr studentized
+ * ranges, each based on cc means and with df degrees of freedom
+ * for the standard error, is less than q.
+ *
+ * The algorithm is based on:
+ * Copenhaver, Margaret Diponzio & Holland, Burt S.
+ * Multiple comparisons of simple effects in
+ * the two-way analysis of variance with fixed effects.
+ * Journal of Statistical Computation and Simulation,
+ * Vol.30, pp.1-15, 1988.
+ *
+ * Uses the secant method to find critical values.
+ * If the difference between successive iterates is less than eps,
+ * the search is terminated and an exception thrown.
+ *
+ * @param p confidence level (1 - alpha)
+ * @param rr no. of rows or groups
+ * @param cc no. of columns or treatments
+ * @param df degrees of freedom of error term
+ *
+ * @return critical value
+ */
+ public static double quantile(double p, double rr, double cc, double df) {
+ final double eps = 0.0001;
+ final int maxiter = 50;
+ double ans, valx0, valx1, x0, x1, xabs;
+ int iter;
+
+ if (Double.isNaN(p) || Double.isNaN(rr) || Double.isNaN(cc) || Double.isNaN(df)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (p < 0 || p > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (p < 0 || p >= 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ /* df must be > 1 */
+ /* there must be at least two values */
+
+ if (df < 2 || rr < 1 || cc < 2) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+
+ if (p <= 0) return 0;
+
+ /* Initial value */
+
+ x0 = qinv(p, cc, df);
+
+ /* Find prob(value < x0) */
+
+ valx0 = cumulative(x0, rr, cc, df) - p;
+
+ /* Find the second iterate and prob(value < x1). */
+ /* If the first iterate has probability value */
+ /* exceeding p then second iterate is 1 less than */
+ /* first iterate; otherwise it is 1 greater. */
+
+ if (valx0 > 0.0) x1 = Math.max(0.0, x0 - 1.0);
+ else x1 = x0 + 1.0;
+ valx1 = cumulative(x1, rr, cc, df) - p;
+
+ /* Find new iterate */
+
+ for (iter=1 ; iter < maxiter ; iter++) {
+ ans = x1 - ((valx1 * (x1 - x0)) / (valx1 - valx0));
+ valx0 = valx1;
+
+ /* New iterate must be >= 0 */
+
+ x0 = x1;
+ if (ans < 0.0) {
+ ans = 0.0;
+ valx1 = -p;
+ }
+ /* Find prob(value < new iterate) */
+
+ valx1 = cumulative(ans, rr, cc, df) - p;
+ x1 = ans;
+
+ /* If the difference between two successive */
+ /* iterates is less than eps, stop */
+
+ /*!* xabs = fabs(x1 - x0); *!*/
+ xabs = java.lang.Math.abs(x1 - x0);
+ if (xabs < eps)
+ return ans;
+ }
+
+ /* The process did not converge in 'maxiter' iterations */
+ throw new java.lang.ArithmeticException("No convergence.");
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Uniform.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Uniform.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Uniform.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Uniform.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,98 @@
+/* DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+package org.mathpiper.builtin.library.statdistlib;
+
+import org.mathpiper.builtin.library.statdistlib.rng.WichmannHill;
+
+/**
+ * Uniform distribution over an interval.
+ */
+
+public class Uniform {
+
+ /**
+ * density of the Uniform distribution.
+ */
+ public static double density(double x, double a, double b) {
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b))
+ return x + a + b;
+ if (b <= a) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (a <= x && x <= b)
+ return 1.0 / (b - a);
+ return 0.0;
+ }
+
+ /**
+ * distribution function of the Uniform distribution.
+ */
+ public static double cumulative(double x, double a, double b) {
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b))
+ return x + a + b;
+ if (b <= a) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (x <= a)
+ return 0.0;
+ if (x >= b)
+ return 1.0;
+ return (x - a) / (b - a);
+ }
+
+ /**
+ * quantile function of the Uniform distribution.
+ */
+ public static double quantile(double x, double a, double b) {
+ if (Double.isNaN(x) || Double.isNaN(a) || Double.isNaN(b))
+ return x + a + b;
+ if (b <= a || x < 0 || x > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ return a + x * (b - a);
+ }
+
+ /**
+ * Random variates from the Uniform distribution.
+ */
+ public static double random(double a, double b) {
+ if (Double.isInfinite(a) || Double.isInfinite(b) || b < a) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ }
+ if (a == b)
+ return a;
+ else
+ return a + (b - a) * random();
+ }
+
+ /**
+ * Generator used during random() call. Can be set.
+ */
+ public static StdUniformRng uniRng = new WichmannHill();
+
+ /**
+ * generate standard Uniform random variate
+ */
+ public static double random() {
+ return uniRng.random();
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Weibull.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Weibull.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Weibull.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Weibull.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,198 @@
+package org.mathpiper.builtin.library.statdistlib;
+
+/* data translated from C using perl script translate.pl */
+/* script version 0.00 */
+
+
+import java.lang.*;
+import java.lang.Math;
+import java.lang.Double;
+
+public class Weibull
+ {
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The density function of the Weibull distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double density(double x, double shape, double scale)
+ {
+ double tmp1, tmp2;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(shape) || Double.isNaN(scale))
+ return x + shape + scale;
+ /*!* #endif /*4!*/
+ if (shape <= 0 || scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isInfinite(x)) return 0;
+ /*!* #endif /*4!*/
+/*!* tmp1 = pow(x / scale, shape - 1); *!*/
+ tmp1 = java.lang.Math.pow(x / scale, shape - 1);
+ tmp2 = tmp1 * (x / scale);
+/*!* return shape * tmp1 * exp(-tmp2) / scale; *!*/
+ return shape * tmp1 * java.lang.Math.exp(-tmp2) / scale;
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double cumulative(double x, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The distribution function of the Weibull distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double cumulative(double x, double shape, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(shape) || Double.isNaN(scale))
+ return x + shape + scale;
+ /*!* #endif /*4!*/
+ if(shape <= 0 || scale <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x <= 0) return 0;
+/*!* return 1.0 - exp(-pow(x / scale, shape)); *!*/
+ return 1.0 - java.lang.Math.exp(-java.lang.Math.pow(x / scale, shape));
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double quantile(double x, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * The quantile function of the Weibull distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double quantile(double x, double shape, double scale)
+ {
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(shape) || Double.isNaN(scale))
+ return x + shape + scale;
+ /*!* #endif /*4!*/
+ if (shape <= 0 || scale <= 0 || x < 0 || x > 1) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (x == 0) return 0;
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (x == 1) return Double.POSITIVE_INFINITY;
+ /*!* #endif /*4!*/
+/*!* return scale * pow(-log(1.0 - x), 1.0 / shape); *!*/
+ return scale * java.lang.Math.pow(-java.lang.Math.log(1.0 - x), 1.0 / shape);
+ }
+ /*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 Ross Ihaka
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * SYNOPSIS
+ *
+ * #include "DistLib.h"
+ * double density(double x, double shape, double scale);
+ *
+ * DESCRIPTION
+ *
+ * Random variates from the Weibull distribution.
+ */
+
+ /*!* #include "DistLib.h" /*4!*/
+
+ public static double random(double shape, double scale, Uniform uniformDistribution)
+ {
+ if (
+ /*!* #ifdef IEEE_754 /*4!*/
+ Double.isInfinite(shape) || Double.isInfinite(scale) ||
+ /*!* #endif /*4!*/
+ shape <= 0.0 || scale <= 0.0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+/*!* return scale * pow(-log(sunif()), 1.0 / shape); *!*/
+ return scale * java.lang.Math.pow(-java.lang.Math.log(uniformDistribution.random()), 1.0 / shape);
+ }
+ }
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Wilcox.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Wilcox.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/statdistlib/Wilcox.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/statdistlib/Wilcox.java 2010-05-24 05:44:51.000000000 +0000
@@ -0,0 +1,214 @@
+/*
+ * DistLib : A C Library of Special Functions
+ * Copyright (C) 1998 R Core Team
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * data translated from C using perl script translate.pl
+ * script version 0.00
+ */
+
+package org.mathpiper.builtin.library.statdistlib;
+
+//import org.apache.commons.logging.Log;
+//import org.apache.commons.logging.LogFactory;
+
+/**
+ * Wrapper of functions for Wilcoxon distribution.
+ *
+ * This actually the Mann-Whitney Ux statistic.
+ */
+
+public class Wilcox {
+ //private static Log log = LogFactory.getLog(Wilcox.class);
+
+ public static final int WILCOX_MMAX = 50;
+ public static final int WILCOX_NMAX = 50;
+
+ /**
+ * check values for too large and log complaint
+ */
+ private static boolean checkSizesLarge(final double m, final double n) {
+ if (m >= WILCOX_MMAX) {
+ //log.info("m should be less than %d\n"+ WILCOX_MMAX);
+ return false;
+ }
+ if (n >= WILCOX_NMAX) {
+ //log.info("n should be less than %d\n"+ WILCOX_NMAX);
+ return false;
+ }
+ return true;
+ }
+
+ /**
+ * round sizes to integer
+ */
+ private static void roundSizes(double m, double n) {
+ m = Math.floor(m + 0.5);
+ n = Math.floor(n + 0.5);
+ }
+
+ // table of exact cumulative probabilities
+ static private double w[][][] = new double[WILCOX_MMAX][WILCOX_NMAX][];
+
+ /**
+ * The density of the Wilcoxon distribution.
+ */
+ static private double cwilcox(int k, int m, int n) {
+ int u = m * n;
+ int c = (int)(u / 2);
+
+ if ((k < 0) || (k > u)) return(0);
+ if (k > c) k = u - k;
+ int i = m;
+ int j = n;
+ if (m >= n) {
+ i = n;
+ j = m;
+ }
+ if (w[i][j] == null) {
+ w[i][j] = new double[c + 1];
+ for (int l = 0; l <= c; l++)
+ w[i][j][l] = -1;
+ }
+ if (w[i][j][k] < 0) {
+ if ((i == 0) || (j == 0))
+ w[i][j][k] = (k == 0)?1.0:0.0;
+ else
+ w[i][j][k] = cwilcox(k - n, m - 1, n) + cwilcox(k, m, n - 1);
+ }
+ return(w[i][j][k]);
+ }
+
+ /**
+ * density function
+ * @param x
+ * @param m
+ * @param n
+ * @return density
+ */
+ public static double density(double x, double m, double n) {
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(x) || Double.isNaN(m) || Double.isNaN(n)) return x + m + n;
+ /*!* #endif /*4!*/
+ roundSizes(m,n);
+ if (m <= 0 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (!checkSizesLarge(m,n)) return Double.NaN;
+
+ /*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if ((x < 0) || (x > m * n))
+ return 0;
+ /*!* return(cwilcox(x, m, n) / choose(m + n, n)); *!*/
+ return(cwilcox((int) x, (int) m, (int) n) / Misc.choose(m + n, n));
+ }
+
+ /**
+ * Cumulative distribution function of the Wilcoxon distribution.
+ */
+ public static double cumulative(double x, double m, double n) {
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(m) || Double.isNaN(n))
+ return x + m + n;
+ if (Double.isInfinite(m) || Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+ roundSizes(m,n);
+ if (m <= 0 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if (!checkSizesLarge(m,n)) return Double.NaN;
+ /*!* x = floor(x + 0.5); *!*/
+ x = java.lang.Math.floor(x + 0.5);
+ if (x < 0.0) return 0;
+ if (x >= m * n) return 1;
+ double p = 0.0;
+ for (int i = 0; i <= x; i++)
+ p += density(i, m, n);
+ return(p);
+ }
+
+ /**
+ * The quantile function of the Wilcoxon distribution.
+ */
+ public static double quantile(double x, double m, double n) {
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ if (Double.isNaN(x) || Double.isNaN(m) || Double.isNaN(n))
+ return x + m + n;
+ if(Double.isInfinite(x) || Double.isInfinite(m) || Double.isInfinite(n)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ /*!* #endif /*4!*/
+
+ roundSizes(m,n);
+ if (x < 0 || x > 1 || m <= 0 || n <= 0) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ };
+ if (!checkSizesLarge(m,n)) return Double.NaN;
+
+ if (x == 0) return(0.0);
+ if (x == 1) return(m * n);
+ double p = 0.0;
+ double q = 0.0;
+ for (;;) {
+ /* Don't call cumulative() for efficiency */
+ p += density(q, m, n);
+ if (p >= x)
+ return(q);
+ q++;
+ }
+ }
+
+ /**
+ * Random variates from the Wilcoxon distribution.
+ */
+ public static double random(double m, double n) {
+
+ /*!* #ifdef IEEE_754 /*4!*/
+ /* NaNs propagated correctly */
+ if (Double.isNaN(m) || Double.isNaN(n)) return(m + n);
+ /*!* #endif /*4!*/
+ roundSizes(m,n);
+ if ((m < 0) || (n < 0)) {
+ throw new java.lang.ArithmeticException("Math Error: DOMAIN");
+ // return Double.NaN;
+ }
+ if ((m == 0) || (n == 0))
+ return(0);
+ double r = 0.0;
+ int k = (int) (m + n);
+ int[] x = new int[k];
+ for (int i = 0; i < k; i++)
+ x[i] = i;
+ for (int i = 0; i < n; i++) {
+ /*!* j = floor(k * sunif()); *!*/
+ int j = (int) java.lang.Math.floor(k * Uniform.random());
+ r += x[j];
+ x[j] = x[--k];
+ }
+ return(r - n * (n - 1) / 2);
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/PatternContainer.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/PatternContainer.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/PatternContainer.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/PatternContainer.java 2010-07-18 20:33:50.000000000 +0000
@@ -13,72 +13,58 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.builtin;
//import org.mathpiper.parametermatchers.PatternContainer;
import org.mathpiper.lisp.cons.ConsPointer;
import org.mathpiper.lisp.LispError;
import org.mathpiper.lisp.Environment;
-import org.mathpiper.builtin.ArgumentList;
-import org.mathpiper.lisp.parametermatchers.Pattern;
-
+import org.mathpiper.lisp.parametermatchers.ParametersPatternMatcher;
/**
- * Allows a org.mathpiper.parametermatchers.Pattern to be placed into a org.mathpiper.lisp.BuiltinObject.
+ * Allows a org.mathpiper.parametermatchers.ParametersPatternMatcher to be placed into a org.mathpiper.lisp.BuiltinObject.
*
*/
-public class PatternContainer extends BuiltinContainer
-{
- protected org.mathpiper.lisp.parametermatchers.Pattern iPatternMatcher;
-
- public PatternContainer(org.mathpiper.lisp.parametermatchers.Pattern aPatternMatcher)
- {
- iPatternMatcher = aPatternMatcher;
- }
+public class PatternContainer extends BuiltinContainer {
+
+ protected ParametersPatternMatcher iPatternMatcher;
+
- public Pattern getPattern()
- {
+ public PatternContainer(org.mathpiper.lisp.parametermatchers.ParametersPatternMatcher aPatternMatcher) {
+ iPatternMatcher = aPatternMatcher;
+ }
+
+
+ public ParametersPatternMatcher getPattern() {
return iPatternMatcher;
}
- public boolean matches(Environment aEnvironment, ConsPointer aArguments) throws Exception
- {
- LispError.lispAssert(iPatternMatcher != null);
- boolean result;
- result = iPatternMatcher.matches(aEnvironment, aArguments);
- return result;
- }
-
- public boolean matches(Environment aEnvironment, ConsPointer[] aArguments) throws Exception
- {
- LispError.lispAssert(iPatternMatcher != null);
- boolean result;
- result = iPatternMatcher.matches(aEnvironment, aArguments);
- return result;
- }
-
- //From BuiltinContainer
- public String send(ArgumentList aArgList)
- {
- return null;
- }
-
- public JavaObject execute(String methodName, Object[] arguemnts) throws Exception
- {
- return null;
- }
-
- public String typeName()
- {
- return "\"Pattern\"";
- }
-
- public Object getObject()
- {
- return null;
+
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer aArguments) throws Exception {
+ LispError.lispAssert(iPatternMatcher != null, aEnvironment, aStackTop);
+ boolean result;
+ result = iPatternMatcher.matches(aEnvironment, aStackTop, aArguments);
+ return result;
+ }
+
+
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception {
+ LispError.lispAssert(iPatternMatcher != null, aEnvironment, aStackTop);
+ boolean result;
+ result = iPatternMatcher.matches(aEnvironment, aStackTop, aArguments);
+ return result;
+ }
+
+ //From BuiltinContainer
+
+ public String typeName() {
+ return "\"Pattern\"";
+ }
+
+
+ public Object getObject() {
+ return this;
}
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/BreakException.java mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/BreakException.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/BreakException.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/BreakException.java 2009-11-01 02:04:48.000000000 +0000
@@ -1,7 +1,4 @@
-/*
- * To change this template, choose Tools | Templates
- * and open the template in the editor.
- */
+
package org.mathpiper.exceptions;
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/EvaluationException.java mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/EvaluationException.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/EvaluationException.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/EvaluationException.java 2010-12-16 01:32:55.000000000 +0000
@@ -13,25 +13,55 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.exceptions;
+
public class EvaluationException extends Exception //Note:tk: made this class public so that clients can use this exception.
{
- private int lineNumber = -1;
+ private int lineNumber = -1;
+ private String fileName = null;
+ private String functionName = null;
+ private String type = null;
+
+
+ public EvaluationException(String message, String fileName, int lineNumber, String functionName) {
+ this("Unspecified", message, fileName, lineNumber, functionName);
+ }
+
+
+
+ public EvaluationException(String type, String message, String fileName, int lineNumber, String functionName) {
+ super(message);
+ this.type = type;
+ this.fileName = fileName;
+ this.lineNumber = lineNumber;
+ this.functionName = functionName;
+ }
+
+ public EvaluationException(String message, String fileName, int lineNumber) {
+ this( message, fileName, lineNumber, null);
+ }
- public EvaluationException(String message,int lineNumber)
- {
- super(message);
- this.lineNumber = lineNumber;
- }
-
- public int getLineNumber()
- {
+
+ public int getLineNumber() {
return lineNumber;
}
-
+
+
+ public String getFileName() {
+ return fileName;
+ }
+
+
+ public String getFunctionName() {
+ return functionName;
+ }
+
+ public String getType() {
+ return type;
+ }
+
+
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/ReturnException.java mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/ReturnException.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/exceptions/ReturnException.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/exceptions/ReturnException.java 2009-11-01 02:04:48.000000000 +0000
@@ -0,0 +1,8 @@
+
+
+package org.mathpiper.exceptions;
+
+
+public class ReturnException extends Exception{
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/AsynchronousInterpreter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/AsynchronousInterpreter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/AsynchronousInterpreter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/AsynchronousInterpreter.java 2010-03-26 02:13:27.000000000 +0000
@@ -24,6 +24,7 @@
import java.util.concurrent.Executors;
import java.util.concurrent.FutureTask;
import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.ConsPointer;
/**
*
@@ -85,10 +86,14 @@
return EvaluationResponse.newInstance();
-
}//end method.
+ public synchronized EvaluationResponse evaluate(ConsPointer inputExpressionPointer) {
+ return interpreter.evaluate(inputExpressionPointer);
+ }
+
+
public void addResponseListener(ResponseListener listener)
{
interpreter.addResponseListener(listener);
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/EvaluationResponse.java mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/EvaluationResponse.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/EvaluationResponse.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/EvaluationResponse.java 2010-12-29 04:07:15.000000000 +0000
@@ -5,13 +5,14 @@
package org.mathpiper.interpreters;
+import org.mathpiper.lisp.cons.ConsPointer;
+
/**
* This class is used by an {@link Interpreter} to send the results of an evaluation to
* client code.
*/
public class EvaluationResponse {
private String result = "";
- private String loadResult = "";
private String sideEffects = "";
private String exceptionMessage = "";
private boolean exceptionThrown = false;
@@ -19,6 +20,7 @@
private int lineNumber;
private String sourceFileName = "";
private Object object = null;
+ private ConsPointer resultList = null;
private EvaluationResponse()
{
@@ -111,7 +113,7 @@
*/
public void setSideEffects(String sideEffects)
{
- this.sideEffects = sideEffects.trim();
+ this.sideEffects = sideEffects;
}
/**
@@ -168,6 +170,18 @@
return exceptionThrown;
}
+
+ /**
+ * Allows the user to obtain a Java object from a function.
+ *
+ * @return a Java object if one is available to return to the user.
+ */
+ public Object getObject()
+ {
+ return object;
+ }
+
+
/**
* Sets a Java object to be returned to the user..
*
@@ -178,14 +192,27 @@
this.object = object;
}
+
+
/**
- * Allows the user to obtain a Java object from a function.
+ * Allows the user to obtain the result list.
*
* @return a Java object if one is available to return to the user.
*/
- public Object getObject()
- {
- return object;
+ public ConsPointer getResultList() {
+ return resultList;
+ }
+
+
+ /**
+ * Sets the result list to be returned to the user..
+ *
+ * @param exception the exception object
+ */
+ public void setResultList(ConsPointer resultList) {
+ this.resultList = resultList;
}
+
+
}//end class.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/Interpreter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/Interpreter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/Interpreter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/Interpreter.java 2010-03-26 02:13:27.000000000 +0000
@@ -17,6 +17,7 @@
package org.mathpiper.interpreters;
import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.ConsPointer;
/**
* Interpreter is implemented by all MathPiper interpreters and it allows client code to evaluate
@@ -45,6 +46,15 @@
public EvaluationResponse evaluate(String expression, boolean notifyListeners);
/**
+ * Evaluates a MathPiper expression. The results of the evaluation are returned
+ * in a {@link EvaluationResponse} object.
+ *
+ * @param expressionPointer the list form of a MathPiper expression to be evaluated
+ * @return an EvaluationResponse object
+ */
+ public EvaluationResponse evaluate(ConsPointer expressionPointer);
+
+ /**
* Halts the current evaluation.
*/
public void haltEvaluation();
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/SynchronousInterpreter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/SynchronousInterpreter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/interpreters/SynchronousInterpreter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/interpreters/SynchronousInterpreter.java 2011-04-24 07:45:56.000000000 +0000
@@ -34,22 +34,28 @@
import org.mathpiper.io.CachedStandardFileInputStream;
import java.io.*;
import java.util.ArrayList;
+import java.util.List;
+import org.mathpiper.builtin.BuiltinContainer;
+import org.mathpiper.builtin.BuiltinFunction;
import org.mathpiper.builtin.JavaObject;
import org.mathpiper.io.StringOutput;
import org.mathpiper.lisp.Evaluator;
+import org.mathpiper.lisp.cons.AtomCons;
+import org.mathpiper.lisp.cons.Cons;
+import org.mathpiper.lisp.cons.SublistCons;
/**
- *
- *
+ *
+ *
*/
class SynchronousInterpreter implements Interpreter {
+
private ArrayList removeListeners;
private ArrayList responseListeners;
-
- private Environment environment = null;
+ private Environment iEnvironment = null;
MathPiperTokenizer tokenizer = null;
LispPrinter printer = null;
- //private String iError = null;
+ //private String iException = null;
String defaultDirectory = null;
String archive = "";
String detect = "";
@@ -57,20 +63,35 @@
boolean inZipFile = false;
MathPiperOutputStream sideEffectsStream;
private static SynchronousInterpreter singletonInstance;
+ private Thread evaluationThread;
+
private SynchronousInterpreter(String docBase) {
- responseListeners = new ArrayList();
+ responseListeners = new ArrayList();
removeListeners = new ArrayList();
-
+
sideEffectsStream = new StringOutput();
+ Utility.scriptsPath = "/org/mathpiper/assembledscripts/";
+
try {
- environment = new Environment(sideEffectsStream);
+ iEnvironment = new Environment(sideEffectsStream);
+
+ BuiltinFunction.addCoreFunctions(iEnvironment);
+
+ if (!Utility.scriptsPath.contains("geogebra")) {
+ List failList = BuiltinFunction.addOptionalFunctions(iEnvironment, "org/mathpiper/builtin/functions/optional/");
+ }
+
+ iEnvironment.pushLocalFrame(true, "");
+
+
+
tokenizer = new MathPiperTokenizer();
- printer = new MathPiperPrinter(environment.iPrefixOperators, environment.iInfixOperators, environment.iPostfixOperators, environment.iBodiedOperators);
+ printer = new MathPiperPrinter(iEnvironment.iPrefixOperators, iEnvironment.iInfixOperators, iEnvironment.iPostfixOperators, iEnvironment.iBodiedOperators);
- environment.iCurrentInput = new CachedStandardFileInputStream(environment.iInputStatus);
+ iEnvironment.iCurrentInput = new CachedStandardFileInputStream(iEnvironment.iInputStatus);
if (docBase != null) {
@@ -107,9 +128,10 @@
//eg docBase = "jar:http://www.geogebra.org/webstart/alpha/geogebra_cas.jar!/";
evaluate("DefaultDirectory(\"" + docBase + "\");");
- }
+ }//end if.
+
+ }//end if.
- }
/* java.net.URL detectURL = java.lang.ClassLoader.getSystemResource("initialization.rep/mathpiperinit.mpi");
@@ -147,13 +169,20 @@
}*/
- EvaluationResponse evaluationResponse = evaluate("Load(\"org/mathpiper/assembledscripts/initialization.rep/mathpiperinit.mpi\");");
+ EvaluationResponse initializationEvaluationResponse = evaluate("LoadScript(\"initialization.rep/mathpiperinit.mpi\");");
+
+ if (initializationEvaluationResponse.isExceptionThrown()) {
+ throw new Exception("Error during system script initialization.");
+ }
+
+ initializationEvaluationResponse = evaluate("LoadScript(\"/mathpiper_user_initialization.mpi\");");
- if (evaluationResponse.isExceptionThrown()) {
- System.out.println(evaluationResponse.getExceptionMessage() + " Source file name: " + evaluationResponse.getSourceFileName() + " Near line number: " + evaluationResponse.getLineNumber());
+ if (!initializationEvaluationResponse.isExceptionThrown()) {
+ System.out.println("The initialization file mathpiper_user_initialization.mpi was evaluated.");
}
+
} catch (Exception e) //Note:tk:need to handle exceptions better here. should return exception to user in an EvaluationResponse.
{
e.printStackTrace();
@@ -161,18 +190,22 @@
}
}//end constructor.
+
private SynchronousInterpreter() {
this(null);
}
+
static SynchronousInterpreter newInstance() {
return new SynchronousInterpreter();
}
+
static SynchronousInterpreter newInstance(String docBase) {
return new SynchronousInterpreter(docBase);
}
+
static SynchronousInterpreter getInstance() {
if (singletonInstance == null) {
singletonInstance = new SynchronousInterpreter();
@@ -180,6 +213,7 @@
return singletonInstance;
}
+
static SynchronousInterpreter getInstance(String docBase) {
if (singletonInstance == null) {
singletonInstance = new SynchronousInterpreter(docBase);
@@ -187,11 +221,23 @@
return singletonInstance;
}
+
public synchronized EvaluationResponse evaluate(String inputExpression) {
- return this.evaluate(inputExpression, false);
+ return this.evaluate(inputExpression, false);
}//end method.
-
+
+
+ /**
+ Evaluate an input expression which is a string.
+
+ @param inputExpression
+ @param notifyEvaluationListeners
+ @return
+ */
public synchronized EvaluationResponse evaluate(String inputExpression, boolean notifyEvaluationListeners) {
+
+ evaluationThread = Thread.currentThread();
+
EvaluationResponse evaluationResponse = EvaluationResponse.newInstance();
if (inputExpression.length() == 0) {
//return (String) "";
@@ -200,29 +246,29 @@
}
String resultString = "";
try {
- environment.iEvalDepth = 0;
-
- //todo:tk:this was causing problems with GeoGebraPoint() on Windows.
+ iEnvironment.iEvalDepth = 0;
+
+ //todo:tk:this was causing problems with GeoGebraPoint() on Windows.
//environment.resetArgumentStack();
- //iError = null;
+ //iException = null;
ConsPointer inputExpressionPointer = new ConsPointer();
- if (environment.iPrettyReader != null) {
+ if (iEnvironment.iPrettyReaderName != null) {
InputStatus someStatus = new InputStatus();
- StringBuffer inp = new StringBuffer();
+ StringBuilder inp = new StringBuilder();
inp.append(inputExpression);
- InputStatus oldstatus = environment.iInputStatus;
- environment.iInputStatus.setTo("String");
- StringInputStream newInput = new StringInputStream(new StringBuffer(inputExpression), environment.iInputStatus);
+ InputStatus oldstatus = iEnvironment.iInputStatus;
+ iEnvironment.iInputStatus.setTo("String");
+ StringInputStream newInput = new StringInputStream(new StringBuffer(inputExpression), iEnvironment.iInputStatus);
- MathPiperInputStream previous = environment.iCurrentInput;
- environment.iCurrentInput = newInput;
+ MathPiperInputStream previous = iEnvironment.iCurrentInput;
+ iEnvironment.iCurrentInput = newInput;
try {
ConsPointer args = new ConsPointer();
- Utility.applyString(environment, inputExpressionPointer,
- environment.iPrettyReader,
+ Utility.applyString(iEnvironment, -1, inputExpressionPointer,
+ iEnvironment.iPrettyReaderName,
args);
} catch (Exception exception) {
if (exception instanceof EvaluationException) {
@@ -234,8 +280,8 @@
evaluationResponse.setExceptionMessage(exception.getMessage());
} finally {
- environment.iCurrentInput = previous;
- environment.iInputStatus.restoreFrom(oldstatus);
+ iEnvironment.iCurrentInput = previous;
+ iEnvironment.iInputStatus.restoreFrom(oldstatus);
}
} else //Else not PrettyPrinter.
{
@@ -247,58 +293,106 @@
inp.append(";");
StringInputStream inputExpressionBuffer = new StringInputStream(inp, someStatus);
- Parser infixParser = new MathPiperParser(tokenizer, inputExpressionBuffer, environment, environment.iPrefixOperators, environment.iInfixOperators, environment.iPostfixOperators, environment.iBodiedOperators);
- infixParser.parse(environment, inputExpressionPointer);
+ Parser infixParser = new MathPiperParser(tokenizer, inputExpressionBuffer, iEnvironment, iEnvironment.iPrefixOperators, iEnvironment.iInfixOperators, iEnvironment.iPostfixOperators, iEnvironment.iBodiedOperators);
+ infixParser.parse(-1, inputExpressionPointer);
}
- ConsPointer result = new ConsPointer();
- environment.iLispExpressionEvaluator.evaluate(environment, result, inputExpressionPointer); //*** The main valuation happens here.
+ return evaluate(inputExpressionPointer, notifyEvaluationListeners);
+
+ } catch (Exception exception) {
+ this.handleException(exception, evaluationResponse);
+ }
+
+ if (notifyEvaluationListeners) {
+ notifyListeners(evaluationResponse);
+ }//end if.
+
+ return evaluationResponse;
+
+ }//end method.
+
+
+ public synchronized EvaluationResponse evaluate(ConsPointer inputExpressionPointer) {
+ return evaluate(inputExpressionPointer, false);
+ }
- if (result.type() == Utility.OBJECT) {
- JavaObject javaObject = (JavaObject) result.car();
- evaluationResponse.setObject(javaObject.getObject());
+
+ /**
+ Evaluate an input expression which is a Lisp list.
+
+ @param inputExpressionPointer
+ @param notifyEvaluationListeners
+ @return
+ */
+ public synchronized EvaluationResponse evaluate(ConsPointer inputExpressionPointer, boolean notifyEvaluationListeners) {
+
+ evaluationThread = Thread.currentThread();
+
+ //return this.evaluate(inputExpression, false);
+ EvaluationResponse evaluationResponse = EvaluationResponse.newInstance();
+
+ String resultString = "Exception";
+
+ try {
+ ConsPointer resultPointer = new ConsPointer();
+ iEnvironment.iLispExpressionEvaluator.evaluate(iEnvironment, -1, resultPointer, inputExpressionPointer); //*** The main evaluation happens here.
+
+ evaluationResponse.setResultList(resultPointer);
+
+ if (resultPointer.type() == Utility.OBJECT) {
+
+ Object object = resultPointer.car();
+
+ if (object instanceof BuiltinContainer) {
+ BuiltinContainer builtinContainer = (BuiltinContainer) object;
+ evaluationResponse.setObject(builtinContainer.getObject());
+ } else {
+ evaluationResponse.setObject(object);
+ }
}//end if.
- String percent = (String) environment.getTokenHash().lookUp("%");
- environment.setGlobalVariable(percent, result, true);
+ //Set the % symbol to the result of the current evaluation.
+ String percent = (String) iEnvironment.getTokenHash().lookUp("%");
+ iEnvironment.setGlobalVariable(-1, percent, resultPointer, true);
+
+ StringBuffer outputBuffer = new StringBuffer();
+ MathPiperOutputStream outputStream = new StringOutputStream(outputBuffer);
- StringBuffer string_out = new StringBuffer();
- MathPiperOutputStream output = new StringOutputStream(string_out);
+ if (iEnvironment.iPrettyPrinterName != null) {
+ //Pretty printer.
+
+ ConsPointer applyResultPointer = new ConsPointer();
+
+ if (iEnvironment.iPrettyPrinterName.equals("\"RForm\"")) {
+ Cons holdAtom = AtomCons.getInstance(iEnvironment, -1, "Hold");
+
+ holdAtom.cdr().setCons(resultPointer.getCons());
+
+ Cons subListCons = SublistCons.getInstance(iEnvironment, holdAtom);
+
+ ConsPointer resultPointerWithHold = new ConsPointer(subListCons);
+
+ Utility.applyString(iEnvironment, -1, applyResultPointer, iEnvironment.iPrettyPrinterName, resultPointerWithHold);
+ } else {
+ Utility.applyString(iEnvironment, -1, applyResultPointer, iEnvironment.iPrettyPrinterName, resultPointer);
+ }
+
+ printer.rememberLastChar(' ');
+ printer.print(-1, applyResultPointer, outputStream, iEnvironment);
+ resultString = outputBuffer.toString();
- if (environment.iPrettyPrinter != null) {
- ConsPointer nonresult = new ConsPointer();
- Utility.applyString(environment, nonresult, environment.iPrettyPrinter, result);
- resultString = string_out.toString();
} else {
+ //Default printer.
printer.rememberLastChar(' ');
- printer.print(result, output, environment);
- resultString = string_out.toString();
+ printer.print(-1, resultPointer, outputStream, iEnvironment);
+ resultString = outputBuffer.toString();
}
- } catch (Exception exception) {
- //Uncomment this for debugging();
- //exception.printStackTrace();
- Evaluator.DEBUG = false;
- Evaluator.VERBOSE_DEBUG = false;
- Evaluator.TRACE_TO_STANDARD_OUT = false;
- Evaluator.iTraced = false;
-
- if (exception instanceof EvaluationException) {
- EvaluationException mpe = (EvaluationException) exception;
- int errorLineNumber = mpe.getLineNumber();
- if (errorLineNumber == -1) {
- errorLineNumber = environment.iInputStatus.lineNumber();
- if (errorLineNumber == -1) {
- errorLineNumber = 1; //Code was probably a single line submitted from the command line or from a single line evaluation request.
- }
- }
- evaluationResponse.setLineNumber(errorLineNumber);
- evaluationResponse.setSourceFileName(environment.iInputStatus.fileName());
- }
- evaluationResponse.setException(exception);
- evaluationResponse.setExceptionMessage(exception.getMessage());
- }
+
+ } catch (Exception exception) {
+ this.handleException(exception, evaluationResponse);
+ }//end catch.
evaluationResponse.setResult(resultString);
@@ -309,50 +403,108 @@
evaluationResponse.setSideEffects(sideEffects);
}
+ /*try{
+ org.mathpiper.builtin.functions.optional.ViewList.evaluate(iEnvironment, -1, inputExpressionPointer);
+ }catch(Exception e)
+ {
+ e.printStackTrace();
+ }*/
+
try {
- if (inputExpression.trim().startsWith("Load")) {
- ConsPointer loadResult = new ConsPointer();
- environment.getGlobalVariable("LoadResult", loadResult);
- StringBuffer string_out = new StringBuffer();
- MathPiperOutputStream output = new StringOutputStream(string_out);
- printer.rememberLastChar(' ');
- printer.print(loadResult, output, environment);
- String loadResultString = string_out.toString();
- //GlobalVariable loadResultVariable = (GlobalVariable) environment.iGlobalState.lookUp("LoadResult");
- evaluationResponse.setResult(loadResultString);
- //environment.iGlobalState.release("LoadResult");
- if (loadResult.type() == Utility.OBJECT) {
- JavaObject javaObject = (JavaObject) loadResult.car();
- evaluationResponse.setObject(javaObject.getObject());
- }//end if.
- }
+ if (inputExpressionPointer.getCons() instanceof SublistCons) {
+
+ Object object = ((ConsPointer) inputExpressionPointer.getCons().car()).car();
+
+ if (object instanceof String && ((String) object).startsWith("Load")) {
+ ConsPointer loadResult = new ConsPointer();
+ iEnvironment.getGlobalVariable(-1, "$LoadResult", loadResult);
+ StringBuffer string_out = new StringBuffer();
+ MathPiperOutputStream output = new StringOutputStream(string_out);
+ printer.rememberLastChar(' ');
+ printer.print(-1, loadResult, output, iEnvironment);
+ String loadResultString = string_out.toString();
+ evaluationResponse.setResult(loadResultString);
+ if (loadResult.type() == Utility.OBJECT) {
+ JavaObject javaObject = (JavaObject) loadResult.car();
+ evaluationResponse.setObject(javaObject.getObject());
+ }//end if.
+ }//if.
+ }//end if
} catch (Exception e) {
evaluationResponse.setExceptionMessage(e.getMessage());
evaluationResponse.setException(e);
}
-
- if(notifyEvaluationListeners)
- {
- notifyListeners(evaluationResponse);
- }//end if.
+
+ if (notifyEvaluationListeners) {
+ notifyListeners(evaluationResponse);
+ }//end if.
return evaluationResponse;
}
+
+ private void handleException(Exception exception, EvaluationResponse evaluationResponse) {
+ //exception.printStackTrace(); //todo:tk:uncomment for debugging.
+
+ Evaluator.DEBUG = false;
+ Evaluator.VERBOSE_DEBUG = false;
+ Evaluator.TRACE_TO_STANDARD_OUT = false;
+ Evaluator.iTraced = false;
+
+ try {
+ iEnvironment.iArgumentStack.reset(-1, iEnvironment);
+ } catch (Exception e) {
+ e.printStackTrace();
+ }
+
+ if (exception instanceof EvaluationException) {
+ EvaluationException mpe = (EvaluationException) exception;
+ int errorLineNumber = mpe.getLineNumber();
+ if (errorLineNumber == -1) {
+ errorLineNumber = iEnvironment.iInputStatus.lineNumber();
+ if (errorLineNumber == -1) {
+ errorLineNumber = 1; //Code was probably a single line submitted from the command line or from a single line evaluation request.
+ }
+ evaluationResponse.setLineNumber(errorLineNumber);
+ evaluationResponse.setSourceFileName(iEnvironment.iInputStatus.fileName());
+ } else {
+ evaluationResponse.setLineNumber(mpe.getLineNumber());
+ evaluationResponse.setSourceFileName(mpe.getFileName());
+ }
+
+
+ } else {
+ int errorLineNumber = iEnvironment.iInputStatus.lineNumber();
+ if (errorLineNumber == -1) {
+ errorLineNumber = 1; //Code was probably a single line submitted from the command line or from a single line evaluation request.
+ }
+ evaluationResponse.setLineNumber(errorLineNumber);
+ evaluationResponse.setSourceFileName(iEnvironment.iInputStatus.fileName());
+ }
+
+ evaluationResponse.setException(exception);
+ evaluationResponse.setExceptionMessage(exception.getMessage());
+ }
+
+
public void haltEvaluation() {
- synchronized (environment) {
- environment.iEvalDepth = environment.iMaxEvalDepth + 100;
+ synchronized (iEnvironment) {
+ //iEnvironment.iEvalDepth = iEnvironment.iMaxEvalDepth + 100; //Deprecated.
+
+ evaluationThread.interrupt();
}
}
+
public Environment getEnvironment() {
- return environment;
+ return iEnvironment;
}
/*public java.util.zip.ZipFile getScriptsZip()
{
return Utility.zipFile;
}//end method.*/
+
public void addScriptsDirectory(String directory) {
String toEvaluate = "DefaultDirectory(\"" + directory + File.separator + "\");";
@@ -360,35 +512,32 @@
}//addScriptsDirectory.
+
public void addResponseListener(ResponseListener listener) {
- responseListeners.add(listener);
+ responseListeners.add(listener);
}
+
public void removeResponseListener(ResponseListener listener) {
- responseListeners.remove(listener);
+ responseListeners.remove(listener);
}
-
-
- protected void notifyListeners(EvaluationResponse response)
- {
+
+
+ protected void notifyListeners(EvaluationResponse response) {
//notify listeners.
- for (ResponseListener listener : responseListeners)
- {
+ for (ResponseListener listener : responseListeners) {
listener.response(response);
- if (listener.remove())
- {
+ if (listener.remove()) {
removeListeners.add(listener);
}//end if.
}//end for.
//Remove certain listeners.
- for (ResponseListener listener : removeListeners)
- {
+ for (ResponseListener listener : removeListeners) {
- if (listener.remove())
- {
+ if (listener.remove()) {
responseListeners.remove(listener);
}//end if.
}//end for.
@@ -396,6 +545,5 @@
removeListeners.clear();
}//end method.
-
}// end class.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/CachedStandardFileInputStream.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/CachedStandardFileInputStream.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/CachedStandardFileInputStream.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/CachedStandardFileInputStream.java 2010-12-29 04:07:15.000000000 +0000
@@ -18,11 +18,6 @@
package org.mathpiper.io;
-
-
-import org.mathpiper.io.MathPiperInputStream;
-import java.io.*;
-
/** CachedStandardFileInputStream : input from stdin */
public class CachedStandardFileInputStream extends MathPiperInputStream
{
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/JarFileInputStream.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/JarFileInputStream.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/JarFileInputStream.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/JarFileInputStream.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,32 +13,28 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.io;
-
import java.io.InputStreamReader;
-import org.mathpiper.io.StringInputStream;
import java.net.*;
-public class JarFileInputStream extends StringInputStream
-{
- public JarFileInputStream(String aFileName, InputStatus aStatus) throws Exception
- {
- super(new StringBuffer(),aStatus);
- URL url = new URL(aFileName);
- JarURLConnection con = (JarURLConnection) url.openConnection();
- InputStreamReader stream = new InputStreamReader(con.getInputStream());
- int c;
- while (true)
- {
- c = stream.read();
- if (c == -1)
- break;
- iString.append((char)c);
- }
- }
+public class JarFileInputStream extends StringInputStream {
+
+ public JarFileInputStream(String aFileName, InputStatus aStatus) throws Exception {
+ super(new StringBuffer(), aStatus);
+ URL url = new URL(aFileName);
+ JarURLConnection con = (JarURLConnection) url.openConnection();
+ InputStreamReader stream = new InputStreamReader(con.getInputStream());
+ int c;
+ while (true) {
+ c = stream.read();
+ if (c == -1) {
+ break;
+ }
+ iString.append((char) c);
+ }
+ }
+
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/StandardFileInputStream.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StandardFileInputStream.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/StandardFileInputStream.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StandardFileInputStream.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,61 +13,55 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.io;
import java.io.InputStreamReader;
+public class StandardFileInputStream
+ extends StringInputStream {
+ // private static String path;
+ //static void setPath(String aPath)
+ //{
+ // path = aPath;
+ //}
+
+ public StandardFileInputStream(String aFileName, InputStatus aStatus)
+ throws Exception {
+ super(new StringBuffer(), aStatus);
+ //System.out.println("YYYYYY " + aFileName);//Note:tk: remove.
+ InputStreamReader stream = new InputStreamReader(new java.io.FileInputStream(aFileName));
+ int c;
+
+ while (true) {
+ c = stream.read();
+
+ if (c == -1) {
+ break;
+ }
+
+ iString.append((char) c);
+ }
+ }
+
+
+ public StandardFileInputStream(java.io.InputStreamReader aStream, InputStatus aStatus)
+ throws Exception {
+ super(new StringBuffer(), aStatus);
+
+ int c;
+
+ while (true) {
+ c = aStream.read();
+
+ if (c == -1) {
+ break;
+ }
+
+ iString.append((char) c);
+ }
+ }
-public class StandardFileInputStream
- extends StringInputStream
-{
- // private static String path;
- //static void setPath(String aPath)
- //{
- // path = aPath;
- //}
-
- public StandardFileInputStream(String aFileName, InputStatus aStatus)
- throws Exception
- {
- super(new StringBuffer(), aStatus);
-
- //System.out.println("YYYYYY " + aFileName);//Note:tk: remove.
- InputStreamReader stream = new InputStreamReader(new java.io.FileInputStream(aFileName));
- int c;
-
- while (true)
- {
- c = stream.read();
-
- if (c == -1)
-
- break;
-
- iString.append((char)c);
- }
- }
-
- public StandardFileInputStream(java.io.InputStreamReader aStream, InputStatus aStatus)
- throws Exception
- {
- super(new StringBuffer(), aStatus);
-
- int c;
-
- while (true)
- {
- c = aStream.read();
-
- if (c == -1)
-
- break;
-
- iString.append((char)c);
- }
- }
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/StringInputStream.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringInputStream.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/StringInputStream.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringInputStream.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,77 +13,74 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.io;
+public class StringInputStream
+ extends MathPiperInputStream {
+
+ int iCurrent;
+ StringBuffer iString;
-import org.mathpiper.io.MathPiperInputStream;
-public class StringInputStream
- extends MathPiperInputStream
-{
+ public StringInputStream(StringBuffer aString, InputStatus aStatus) {
+ super(aStatus);
+ iString = aString;
+ iCurrent = 0;
+ }
+
+
+ public char next()
+ throws Exception {
+
+ if (iCurrent == iString.length()) {
+ return '\0';
+ }
- int iCurrent;
- StringBuffer iString;
+ iCurrent++;
- public StringInputStream(StringBuffer aString, InputStatus aStatus)
- {
- super(aStatus);
- iString = aString;
- iCurrent = 0;
- }
+ char c = iString.charAt(iCurrent - 1);
- public char next()
- throws Exception
- {
+ if (c == '\n') {
+ iStatus.nextLine();
+ }
- if (iCurrent == iString.length())
+ return c;
+ }
- return '\0';
- iCurrent++;
+ public char peek()
+ throws Exception {
- char c = iString.charAt(iCurrent - 1);
+ if (iCurrent == iString.length()) {
+ return '\0';
+ }
- if (c == '\n')
- iStatus.nextLine();
+ return iString.charAt(iCurrent);
+ }
- return c;
- }
- public char peek()
- throws Exception
- {
+ public boolean endOfStream() {
- if (iCurrent == iString.length())
+ return (iCurrent == iString.length());
+ }
- return '\0';
- return iString.charAt(iCurrent);
- }
+ public StringBuffer startPtr() {
- public boolean endOfStream()
- {
+ return iString;
+ }
- return (iCurrent == iString.length());
- }
- public StringBuffer startPtr()
- {
+ public int position() {
- return iString;
- }
+ return iCurrent;
+ }
- public int position()
- {
- return iCurrent;
- }
+ public void setPosition(int aPosition) {
+ iCurrent = aPosition;
+ }
- public void setPosition(int aPosition)
- {
- iCurrent = aPosition;
- }
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/StringOutput.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringOutput.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/StringOutput.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringOutput.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,52 +13,46 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.io;
-public class StringOutput implements MathPiperOutputStream
-{
- StringBuffer stringBuffer;
-
- public StringOutput()
- {
- this.stringBuffer = new java.lang.StringBuffer();
- }
-
- public void putChar(char aChar)
- {
- this.stringBuffer.append(aChar);
- }
-
-
- /*public void setStringBuffer(StringBuffer stringBuffer)
- {
- this.stringBuffer = stringBuffer;
- }//end method.*/
-
-
- public String toString()
- {
- if(this.stringBuffer.length() != 0)
- {
- String outputMessage = this.stringBuffer.toString();
- this.clear();
- return outputMessage;
- }
- else
- {
- return null;
- }//end else.
-
-
- }//end method.
-
- public void clear()
- {
- this.stringBuffer.delete(0, this.stringBuffer.length());
- }
+public class StringOutput implements MathPiperOutputStream {
+
+ StringBuffer stringBuffer;
+
+
+ public StringOutput() {
+ this.stringBuffer = new java.lang.StringBuffer();
+ }
+
+
+ public void putChar(char aChar) {
+ this.stringBuffer.append(aChar);
+ }
+
+
+ /*public void setStringBuffer(StringBuffer stringBuffer)
+ {
+ this.stringBuffer = stringBuffer;
+ }//end method.*/
+ public String toString() {
+ if (this.stringBuffer.length() != 0) {
+ String outputMessage = this.stringBuffer.toString();
+ this.clear();
+ return outputMessage;
+ } else {
+ return null;
+ }//end else.
+
+
+ }//end method.
+
+
+ public void clear() {
+ this.stringBuffer.delete(0, this.stringBuffer.length());
+ }
+
public void write(String aString) throws Exception {
int i;
@@ -66,5 +60,5 @@
putChar(aString.charAt(i));
}
}
-
-}//end class.
\ No newline at end of file
+
+}//end class.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/io/StringOutputStream.java mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringOutputStream.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/io/StringOutputStream.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/io/StringOutputStream.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,27 +13,24 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.io;
-import org.mathpiper.io.MathPiperOutputStream;
+public class StringOutputStream implements MathPiperOutputStream {
+
+ StringBuffer iString;
-public class StringOutputStream implements MathPiperOutputStream
-{
- StringBuffer iString;
+ public StringOutputStream(StringBuffer aString) {
+ iString = aString;
+ }
+
+
+ public void putChar(char aChar) {
+ iString.append(aChar);
+ }
- public StringOutputStream(StringBuffer aString)
- {
- iString = aString;
- }
-
- public void putChar(char aChar)
- {
- iString.append(aChar);
- }
public void write(String aString) throws Exception {
int i;
@@ -41,4 +38,5 @@
putChar(aString.charAt(i));
}
}
+
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/license.txt mathpiper-0.81f+dfsg1/src/org/mathpiper/license.txt
--- mathpiper-0.0.svn2556/src/org/mathpiper/license.txt 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/license.txt 2011-03-24 18:52:52.000000000 +0000
@@ -0,0 +1,4 @@
+MathPiper 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.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/BackQuoteSubstitute.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/BackQuoteSubstitute.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/BackQuoteSubstitute.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/BackQuoteSubstitute.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,9 +13,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.behaviours;
import org.mathpiper.lisp.cons.Cons;
@@ -32,60 +30,65 @@
* head of function if a is a function. For instance, if
* a is f(x) and f is g, then f(x) gets replaced by g(x)
*/
-public class BackQuoteSubstitute implements Substitute
-{
- Environment iEnvironment;
-
- public BackQuoteSubstitute(Environment aEnvironment)
- {
- iEnvironment = aEnvironment;
- }
- public boolean matches(Environment aEnvironment,ConsPointer aResult, ConsPointer aElement) throws Exception
- {
- if (! (aElement.car() instanceof ConsPointer)) return false;
-
- Cons ptr = ((ConsPointer) aElement.car()).getCons();
- if (ptr == null) return false;
-
- if (!( ptr.car() instanceof String)) return false;
-
- if (ptr.car().equals("`"))
- {
- aResult.setCons(aElement.getCons());
- return true;
- }
-
- if (!ptr.car().equals("@"))
- return false;
-
- ptr = ptr.cdr().getCons();
-
- if (ptr == null)
- return false;
-
- if (ptr.car() instanceof String)
- {
- ConsPointer cur = new ConsPointer();
- cur.setCons(ptr);
- iEnvironment.iLispExpressionEvaluator.evaluate(iEnvironment, aResult, cur);
- return true;
- }
- else
- {
- ptr = ((ConsPointer) ptr.car()).getCons();
- ConsPointer cur = new ConsPointer();
- cur.setCons(ptr);
- ConsPointer args = new ConsPointer();
- args.setCons(ptr.cdr().getCons());
- ConsPointer result = new ConsPointer();
- iEnvironment.iLispExpressionEvaluator.evaluate(iEnvironment, result, cur);
- result.cdr().setCons(args.getCons());
- ConsPointer result2 = new ConsPointer();
- result2.setCons(SublistCons.getInstance(aEnvironment,result.getCons()));
- Utility.substitute(aEnvironment, aResult,result2, this);
- return true;
- }
- // return false;
- }
+public class BackQuoteSubstitute implements Substitute {
+
+ Environment iEnvironment;
+
+
+ public BackQuoteSubstitute(Environment aEnvironment) {
+ iEnvironment = aEnvironment;
+ }
+
+
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aElement) throws Exception {
+ if (!(aElement.car() instanceof ConsPointer)) {
+ return false;
+ }
+
+ Cons ptr = ((ConsPointer) aElement.car()).getCons();
+ if (ptr == null) {
+ return false;
+ }
+
+ if (!(ptr.car() instanceof String)) {
+ return false;
+ }
+
+ if (ptr.car().equals("`")) {
+ aResult.setCons(aElement.getCons());
+ return true;
+ }
+
+ if (!ptr.car().equals("@")) {
+ return false;
+ }
+
+ ptr = ptr.cdr().getCons();
+
+ if (ptr == null) {
+ return false;
+ }
+
+ if (ptr.car() instanceof String) {
+ ConsPointer cur = new ConsPointer();
+ cur.setCons(ptr);
+ iEnvironment.iLispExpressionEvaluator.evaluate(iEnvironment, aStackTop, aResult, cur);
+ return true;
+ } else {
+ ptr = ((ConsPointer) ptr.car()).getCons();
+ ConsPointer cur = new ConsPointer();
+ cur.setCons(ptr);
+ ConsPointer args = new ConsPointer();
+ args.setCons(ptr.cdr().getCons());
+ ConsPointer result = new ConsPointer();
+ iEnvironment.iLispExpressionEvaluator.evaluate(iEnvironment, aStackTop, result, cur);
+ result.cdr().setCons(args.getCons());
+ ConsPointer result2 = new ConsPointer();
+ result2.setCons(SublistCons.getInstance(aEnvironment, result.getCons()));
+ Utility.substitute(aEnvironment, aStackTop, aResult, result2, this);
+ return true;
+ }
+ // return false;
+ }
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/ExpressionSubstitute.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/ExpressionSubstitute.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/ExpressionSubstitute.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/ExpressionSubstitute.java 2010-12-29 04:07:15.000000000 +0000
@@ -4,36 +4,34 @@
import org.mathpiper.lisp.cons.ConsPointer;
import org.mathpiper.lisp.Environment;
-
/** Substing one expression for another. The simplest form
* of substitution
*/
public class ExpressionSubstitute
- implements Substitute
-{
+ implements Substitute {
+
+ Environment iEnvironment;
+ ConsPointer iToMatch;
+ ConsPointer iToReplaceWith;
+
+
+ public ExpressionSubstitute(Environment aEnvironment, ConsPointer aToMatch, ConsPointer aToReplaceWith) {
+ iEnvironment = aEnvironment;
+ iToMatch = aToMatch;
+ iToReplaceWith = aToReplaceWith;
+ }
+
+
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aElement)
+ throws Exception {
+
+ if (Utility.equals(iEnvironment, aStackTop, aElement, iToMatch)) {
+ aResult.setCons(iToReplaceWith.getCons().copy(aEnvironment, false));
- Environment iEnvironment;
- ConsPointer iToMatch;
- ConsPointer iToReplaceWith;
-
- public ExpressionSubstitute(Environment aEnvironment, ConsPointer aToMatch, ConsPointer aToReplaceWith)
- {
- iEnvironment = aEnvironment;
- iToMatch = aToMatch;
- iToReplaceWith = aToReplaceWith;
- }
-
- public boolean matches(Environment aEnvironment,ConsPointer aResult, ConsPointer aElement)
- throws Exception
- {
-
- if (Utility.equals(iEnvironment, aElement, iToMatch))
- {
- aResult.setCons(iToReplaceWith.getCons().copy( aEnvironment, false));
+ return true;
+ }
- return true;
- }
+ return false;
+ }
- return false;
- }
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/LocalSymbolSubstitute.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/LocalSymbolSubstitute.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/behaviours/LocalSymbolSubstitute.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/behaviours/LocalSymbolSubstitute.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,9 +13,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.behaviours;
import org.mathpiper.lisp.cons.ConsPointer;
@@ -25,42 +23,40 @@
/** Substitute behaviour for changing the local variables to have unique
* names.
*/
-public class LocalSymbolSubstitute implements Substitute
-{
- Environment iEnvironment;
- String[] iOriginalNames;
- String[] iNewNames;
- int iNumberOfNames;
-
- public LocalSymbolSubstitute(Environment aEnvironment,
- String[] aOriginalNames,
- String[] aNewNames, int aNrNames)
- {
- iEnvironment = aEnvironment;
- iOriginalNames = aOriginalNames;
- iNewNames = aNewNames;
- iNumberOfNames = aNrNames;
- }
- public boolean matches(Environment aEnvironment,ConsPointer aResult, ConsPointer aElement) throws Exception
- {
-
- if (!(aElement.car() instanceof String))
- {
- return false;
+public class LocalSymbolSubstitute implements Substitute {
+
+ Environment iEnvironment;
+ String[] iOriginalNames;
+ String[] iNewNames;
+ int iNumberOfNames;
+
+
+ public LocalSymbolSubstitute(Environment aEnvironment,
+ String[] aOriginalNames,
+ String[] aNewNames, int aNrNames) {
+ iEnvironment = aEnvironment;
+ iOriginalNames = aOriginalNames;
+ iNewNames = aNewNames;
+ iNumberOfNames = aNrNames;
+ }
+
+
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aElement) throws Exception {
+
+ if (!(aElement.car() instanceof String)) {
+ return false;
}//end if.
String name = (String) aElement.car();
- int i;
- for (i=0;i
+public class DefFileMap extends MathPiperMap //
{
public DefFile getFile(String aFileName)
{
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/Map.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/Map.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/Map.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/Map.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,88 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.collections;
-
-import java.util.Collections;
-
-/** Map allows you to associate arbitrary
- * information with a string in the above hash table. You can
- * specify what type of information to link to the string, and
- * this class then stores that information for a string. It is
- * in a sense a way to extend the string object without modifying
- * the string class itself. This class does not own the strings it
- * points to, but instead relies on the fact that the strings
- * are maintained in a hash table (like LispHashTable above).
- */
-public class Map
-{
- //java.util.Hashtable iMap = new java.util.Hashtable();
- java.util.Map iMap = Collections.synchronizedMap(new java.util.HashMap());
-
- /**
- * Find the data associated to \a aString.
- * If \a aString is not stored in the hash table, this function
- * returns #NULL.
- *
- * @param aString
- * @return the object which is associated with the key or null if there is
- * no object associated with the key.
- */
- public Object lookUp(String aString)
- {
- //if (iMap.containsKey(aString))
- // return iMap.get(aString);
- //return null;
- return iMap.get(aString);
- }
-
- /**
- * Add an association to the hash table.
- * If aString is already stored in the hash table, its
- * association is changed to aData. Otherwise, a new
- * association is added.
- *
- * @param aData
- * @param aString
- */
- public void setAssociation(Object aData, String aString)
- {
- //if (iMap.containsKey(aString))
- // iMap.remove(aString);
-
- iMap.put(aString, aData);
- }
-
-
- /**
- * Delete an association from the hash table.
- *
- * @param aString
- */
- public void release(String aString)
- {
- //if (iMap.containsKey(aString))
- //iMap.remove(aString);
- iMap.remove(aString);
- }
-
- public Object getMap()
- {
- return iMap;
- }
-}
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/MathPiperMap.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/MathPiperMap.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/MathPiperMap.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/MathPiperMap.java 2010-01-31 23:00:37.000000000 +0000
@@ -0,0 +1,89 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.collections;
+
+import java.util.Collections;
+
+/** MathPiperMap allows you to associate arbitrary
+ * information with a string in the above hash table. You can
+ * specify what type of information to link to the string, and
+ * this class then stores that information for a string. It is
+ * in a sense a way to extend the string object without modifying
+ * the string class itself. This class does not own the strings it
+ * points to, but instead relies on the fact that the strings
+ * are maintained in a hash table (like LispHashTable above).
+ */
+public class MathPiperMap
+{
+ //java.util.Hashtable iMap = new java.util.Hashtable();
+ java.util.Map iMap = Collections.synchronizedMap(new java.util.HashMap());
+
+ /**
+ * Find the data associated to \a aString.
+ * If \a aString is not stored in the hash table, this function
+ * returns #NULL.
+ *
+ * @param aString
+ * @return the object which is associated with the key or null if there is
+ * no object associated with the key.
+ */
+ public Object lookUp(String aString)
+ {
+ //if (iMap.containsKey(aString))
+ // return iMap.get(aString);
+ //return null;
+ return iMap.get(aString);
+ }
+
+ /**
+ * Add an association to the hash table.
+ * If aString is already stored in the hash table, its
+ * association is changed to aData. Otherwise, a new
+ * association is added.
+ *
+ * @param aData
+ * @param aString
+ */
+ public void setAssociation(Object aData, String aString)
+ {
+ //if (iMap.containsKey(aString))
+ // iMap.remove(aString);
+
+ iMap.put(aString, aData);
+ }
+
+
+ /**
+ * Delete an association from the hash table.
+ *
+ * @param aString
+ */
+ public void release(String aString)
+ {
+ //if (iMap.containsKey(aString))
+ //iMap.remove(aString);
+ iMap.remove(aString);
+ }
+
+
+ public java.util.Map getMap()
+ {
+ return iMap;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/OperatorMap.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/OperatorMap.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/OperatorMap.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/OperatorMap.java 2010-02-05 10:28:57.000000000 +0000
@@ -21,33 +21,39 @@
import org.mathpiper.lisp.*;
-public class OperatorMap extends Map //
+public class OperatorMap extends MathPiperMap //
{
-
+ Environment iEnvironment;
+
+ public OperatorMap(Environment aEnvironment)
+ {
+ iEnvironment = aEnvironment;
+ }
+
public void setOperator(int aPrecedence,String aString)
{
- InfixOperator op = new InfixOperator(aPrecedence);
+ Operator op = new Operator(aPrecedence);
setAssociation(op, aString);
}
- public void setRightAssociative(String aString) throws Exception
+ public void setRightAssociative(int aStackTop, String aString) throws Exception
{
- InfixOperator op = (InfixOperator)lookUp(aString);
- LispError.check(op != null,LispError.NOT_AN_INFIX_OPERATOR);
+ Operator op = (Operator)lookUp(aString);
+ LispError.check(iEnvironment, aStackTop, op != null,LispError.NOT_AN_INFIX_OPERATOR, "INTERNAL");
op.setRightAssociative();
}
- public void setLeftPrecedence(String aString,int aPrecedence) throws Exception
+ public void setLeftPrecedence(int aStackTop, String aString,int aPrecedence) throws Exception
{
- InfixOperator op = (InfixOperator)lookUp(aString);
- LispError.check(op != null,LispError.NOT_AN_INFIX_OPERATOR);
+ Operator op = (Operator)lookUp(aString);
+ LispError.check(iEnvironment, aStackTop, op != null,LispError.NOT_AN_INFIX_OPERATOR, "INTERNAL");
op.setLeftPrecedence(aPrecedence);
}
- public void setRightPrecedence(String aString,int aPrecedence) throws Exception
+ public void setRightPrecedence(int aStackTop, String aString,int aPrecedence) throws Exception
{
- InfixOperator op = (InfixOperator)lookUp(aString);
- LispError.check(op != null,LispError.NOT_AN_INFIX_OPERATOR);
+ Operator op = (Operator)lookUp(aString);
+ LispError.check(iEnvironment, aStackTop, op != null,LispError.NOT_AN_INFIX_OPERATOR, "INTERNAL");
op.setRightPrecedence(aPrecedence);
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/TokenMap.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/TokenMap.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/collections/TokenMap.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/collections/TokenMap.java 2010-01-31 23:00:37.000000000 +0000
@@ -17,7 +17,7 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.collections;
-public class TokenMap extends Map
+public class TokenMap extends MathPiperMap
{
// java.util.Hashtable iMap = new java.util.Hashtable();
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/AtomCons.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/AtomCons.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/AtomCons.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/AtomCons.java 2010-12-29 05:45:51.000000000 +0000
@@ -18,35 +18,36 @@
package org.mathpiper.lisp.cons;
import org.mathpiper.lisp.*;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.Cons;
public class AtomCons extends Cons
{
private String iCar;
- ConsPointer iCdr = new ConsPointer();
+ ConsPointer iCdr;
- private AtomCons(Environment aEnvironment,String aString) throws Exception
+ public AtomCons(String aString) throws Exception
{
- super(aEnvironment);
+ //Make sure to use aEnvironment.getTokenHash().lookUp(aString) with aString before calling this constructor.
+
+ super();
iCar = aString;
+ iCdr = new ConsPointer();
}
- public static Cons getInstance(Environment aEnvironment, String aString) throws Exception
+ public static Cons getInstance(Environment aEnvironment, int aStackTop, String aString) throws Exception
{
Cons self = null;
if (Utility.isNumber(aString, true)) // check if aString is a number (int or float)
{
/// construct a number from a decimal string representation (also create a number object)
- self = new NumberCons(aEnvironment, aString, aEnvironment.getPrecision());
+ self = new NumberCons(aString, aEnvironment.getPrecision());
} else
{
- self = new AtomCons(aEnvironment,(String)aEnvironment.getTokenHash().lookUp(aString));
+ self = new AtomCons((String)aEnvironment.getTokenHash().lookUp(aString));
}
- LispError.check(self != null, LispError.NOT_ENOUGH_MEMORY);
+ LispError.check(aEnvironment, aStackTop, self != null, LispError.NOT_ENOUGH_MEMORY, "INTERNAL");
return self;
}
@@ -62,9 +63,9 @@
return car();
}*/
- public Cons copy( Environment aEnvironment, boolean aRecursed) throws Exception
+ public Cons copy( Environment aEnvironment, boolean aRecursed) throws Exception
{
- Cons atomCons = new AtomCons(aEnvironment, iCar);
+ Cons atomCons = new AtomCons(iCar);
atomCons.setMetadataMap(this.getMetadataMap());
@@ -77,6 +78,7 @@
return iCdr;
}
+ @Override
public String toString()
{
return iCar;
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/BuiltinObjectCons.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/BuiltinObjectCons.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/BuiltinObjectCons.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/BuiltinObjectCons.java 2010-12-29 04:07:15.000000000 +0000
@@ -18,21 +18,25 @@
import org.mathpiper.lisp.*;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.Cons;
import org.mathpiper.builtin.BuiltinContainer;
public class BuiltinObjectCons extends Cons {
BuiltinContainer iCarBuiltin;
- ConsPointer iCdr = new ConsPointer();
+ ConsPointer iCdr;
- public static BuiltinObjectCons getInstance(Environment aEnvironment,BuiltinContainer aClass) throws Exception {
- LispError.lispAssert(aClass != null);
+ private BuiltinObjectCons(Environment aEnvironment, BuiltinContainer aClass) throws Exception {
+ super();
+ iCarBuiltin = aClass;
+ iCdr = new ConsPointer();
+ }
+
+ public static BuiltinObjectCons getInstance(Environment aEnvironment, int aStackTop, BuiltinContainer aClass) throws Exception {
+ LispError.lispAssert(aClass != null, aEnvironment, aStackTop);
BuiltinObjectCons self = new BuiltinObjectCons(aEnvironment, aClass);
- LispError.check(self != null, LispError.NOT_ENOUGH_MEMORY);
+ LispError.check(aEnvironment, aStackTop, self != null, LispError.NOT_ENOUGH_MEMORY, "INTERNAL");
return self;
}
@@ -53,11 +57,6 @@
}
- BuiltinObjectCons(Environment aEnvironment, BuiltinContainer aClass) throws Exception {
- super(aEnvironment);
- iCarBuiltin = aClass;
- }
-
public ConsPointer cdr() {
return iCdr;
@@ -67,4 +66,12 @@
public int type() {
return Utility.OBJECT;
}//end method.
+
+
+ @Override
+ public String toString()
+ {
+ return "JavaObject: " + this.iCarBuiltin.getObject().toString();
+ }//end method.
+
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/Cons.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/Cons.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/Cons.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/Cons.java 2010-02-06 21:01:49.000000000 +0000
@@ -35,14 +35,12 @@
protected Map metadataMap;
-
- public Cons(Environment aEnvironment) throws Exception
+ public Cons() throws Exception
{
metadataMap = null; //aEnvironment.iEmptyAtom;
}//end constructor.
-
public abstract ConsPointer cdr();
public abstract Object car() throws Exception;
@@ -54,7 +52,7 @@
/**
* If this is a number, return a BigNumber representation of it.
*/
- public Object getNumber(int aPrecision) throws Exception {
+ public Object getNumber(int aPrecision, Environment aEnvironment) throws Exception {
return null;
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsPointerArray.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsPointerArray.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsPointerArray.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsPointerArray.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,67 +13,58 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.cons;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.Cons;
-
+import org.mathpiper.lisp.Environment;
/**
* Similar to ConsPointer, but implements an array of pointers to CONS.
*
*/
-public class ConsPointerArray
-{
- int iSize;
- ConsPointer iArray[];
-
- public ConsPointerArray(int aSize,Cons aInitialItem)
- {
- iArray = new ConsPointer[aSize];
- iSize = aSize;
- int i;
- for(i=0;i0 && last > 0 && first < iSize-1 && last < iSize-1)
- {
- ConsPointer[] arguments = new ConsPointer[last-first];
+public class ConsPointerArray {
+
+ int iSize;
+ ConsPointer iArray[];
+
+
+ public ConsPointerArray(Environment aEnvironment, int aSize, Cons aInitialItem) {
+ iArray = new ConsPointer[aSize];
+ iSize = aSize;
+ int i;
+ for (i = 0; i < aSize; i++) {
+ iArray[i] = new ConsPointer();
+ iArray[i].setCons(aInitialItem);
+ }
+ }
+
+
+ public int size() {
+ return iSize;
+ }
+
+
+ public ConsPointer getElement(int aItem) {
+ return iArray[aItem];
+ }
+
+
+ public ConsPointer[] getElements(int first, int last) throws IndexOutOfBoundsException {
+ if (first < last && first > 0 && last > 0 && first < iSize - 1 && last < iSize - 1) {
+ ConsPointer[] arguments = new ConsPointer[last - first];
int i = 0;
- for(int x = first; x < last; x++)
- {
+ for (int x = first; x < last; x++) {
arguments[i++] = iArray[x];
}
return arguments;
- }
- else
- {
+ } else {
throw new IndexOutOfBoundsException("Stack index is out of bounds.");
}
}
-
- public void setElement(int aItem,Cons aCons)
- {
- iArray[aItem].setCons(aCons);
- }
+
+
+ public void setElement(int aItem, Cons aCons) {
+ iArray[aItem].setCons(aCons);
+ }
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsPointer.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsPointer.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsPointer.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsPointer.java 2010-12-29 04:07:15.000000000 +0000
@@ -18,8 +18,8 @@
package org.mathpiper.lisp.cons;
import org.mathpiper.io.StringOutput;
+import org.mathpiper.lisp.Environment;
import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.cons.Cons;
import org.mathpiper.lisp.printers.LispPrinter;
/**
@@ -34,6 +34,7 @@
Cons iCons;
+
public Object car() throws Exception {
return iCons.car();
}
@@ -42,11 +43,14 @@
return iCons.cdr();
}
- public ConsPointer() {
- iCons = null;
+ public ConsPointer()
+ {
+ super();
}
- public ConsPointer(Cons aCons) {
+
+ public ConsPointer( Cons aCons) {
+ super();
iCons = aCons;
}
@@ -65,22 +69,23 @@
//iPointer = (iPointer.cdr());
- public void goNext() throws Exception {
- LispError.check(iCons != null, LispError.NOT_LONG_ENOUGH);
+ public void goNext(int aStackTop , Environment aEnvironment) throws Exception {
+ LispError.check(aEnvironment, aStackTop, iCons != null, LispError.NOT_LONG_ENOUGH, "INTERNAL");
iCons = iCons.cdr().iCons;
}
- public void goSub() throws Exception {
- LispError.check(iCons != null, LispError.INVALID_ARGUMENT);
- LispError.check(iCons.car() instanceof ConsPointer, LispError.NOT_A_LIST);
+ public void goSub(int aStackTop , Environment aEnvironment) throws Exception {
+ LispError.check(aEnvironment, aStackTop, iCons != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, iCons.car() instanceof ConsPointer, LispError.NOT_A_LIST, "INTERNAL");
iCons = ((ConsPointer)iCons.car()).getCons();
}
+ @Override
public String toString() {
StringOutput out = new StringOutput();
LispPrinter printer = new LispPrinter();
try {
- printer.print(this, out, null);
+ printer.print(-1, this, out, null);
} catch (Exception e) {
e.printStackTrace();
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsTraverser.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsTraverser.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/ConsTraverser.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/ConsTraverser.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,14 +13,10 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.cons;
import org.mathpiper.lisp.*;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.Cons;
/**
* Works almost like ConsPointer, but doesn't enforce
@@ -28,47 +24,53 @@
* should be used instead of ConsPointer if you are going to traverse
* a lisp expression in a non-destructive way.
*/
-public class ConsTraverser
-{
- ConsPointer iPointer;
-
- public ConsTraverser(ConsPointer aPtr)
- {
- iPointer = aPtr;
- }
+public class ConsTraverser {
- public Object car() throws Exception
- {
+ ConsPointer iPointer;
+ ConsPointer iHeadPointer;
+
+ private Environment iEnvironment;
+
+ public ConsTraverser(Environment aEnvironment, ConsPointer aPtr) {
+ iEnvironment = aEnvironment;
+ iPointer = aPtr;
+ iHeadPointer = aPtr;
+ }
+
+ public Object car() throws Exception {
return iPointer.car();
}
- public ConsPointer cdr()
- {
+ public ConsPointer cdr() {
return iPointer.cdr();
}
-
- public Cons getCons()
- {
- return iPointer.getCons();
- }
-
- public ConsPointer getPointer()
- {
- return iPointer;
- }
-
- public void goNext() throws Exception
- {
- LispError.check(iPointer.getCons() != null,LispError.NOT_LONG_ENOUGH);
- iPointer = (iPointer.cdr());
- }
-
- public void goSub() throws Exception
- {
- LispError.check(iPointer.getCons() != null,LispError.INVALID_ARGUMENT);
- LispError.check(iPointer.car() instanceof ConsPointer,LispError.NOT_A_LIST);
- iPointer = (ConsPointer) iPointer.car();
- }
+ public Cons getCons() {
+ return iPointer.getCons();
+ }
+
+ public void setCons(Cons aCons) {
+ iPointer.setCons(aCons);
+ }
+
+ public ConsPointer getPointer() {
+ return iPointer;
+ }
+
+ public ConsPointer getHeadPointer()
+ {
+ return iHeadPointer;
+ }
+
+ public void goNext(int aStackTop) throws Exception {
+ LispError.check(iEnvironment, aStackTop, iPointer.getCons() != null, LispError.NOT_LONG_ENOUGH, "INTERNAL");
+ iPointer = (iPointer.cdr());
+ }
+
+ public void goSub(int aStackTop) throws Exception {
+ LispError.check(iEnvironment, aStackTop, iPointer.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(iEnvironment, aStackTop, iPointer.car() instanceof ConsPointer, LispError.NOT_A_LIST, "INTERNAL");
+ iPointer = (ConsPointer) iPointer.car();
+ }
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/NumberCons.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/NumberCons.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/NumberCons.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/NumberCons.java 2010-12-29 04:07:15.000000000 +0000
@@ -18,9 +18,8 @@
package org.mathpiper.lisp.cons;
import org.mathpiper.lisp.*;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.Cons;
import org.mathpiper.builtin.BigNumber;
+import org.mathpiper.exceptions.EvaluationException;
/**
@@ -35,7 +34,7 @@
private BigNumber iCarBigNumber;
/// string representation in decimal; NULL if not yet converted from BigNumber
private String iCarStringNumber;
- private ConsPointer iCdr = new ConsPointer();
+ private ConsPointer iCdr;
/**
* Construct a number from either a BigNumber or a String.
@@ -43,20 +42,22 @@
* @param aNumber
* @param aString
*/
- public NumberCons(Environment aEnvironment,BigNumber aNumber, String aString) throws Exception {
- super(aEnvironment);
+ public NumberCons(BigNumber aNumber, String aString) throws Exception {
+ super();
iCarStringNumber = aString;
iCarBigNumber = aNumber;
+ iCdr = new ConsPointer();
}
/**
* Construct a number from a BigNumber.
* @param aNumber
*/
- public NumberCons(Environment aEnvironment,BigNumber aNumber) throws Exception {
- super(aEnvironment);
+ public NumberCons(BigNumber aNumber) throws Exception {
+ super();
iCarStringNumber = null;
iCarBigNumber = aNumber;
+ iCdr = new ConsPointer();
}
/**
@@ -65,11 +66,12 @@
* @param aString a number in decimal format
* @param aBasePrecision the number of decimal digits for the number
*/
- public NumberCons(Environment aEnvironment,String aString, int aBasePrecision) throws Exception {
- super(aEnvironment);
+ public NumberCons(String aString, int aBasePrecision) throws Exception {
+ super();
//(also create a number object).
iCarStringNumber = aString;
iCarBigNumber = null; // purge whatever it was.
+ iCdr = new ConsPointer();
// create a new BigNumber object out of iString, set its precision in digits
//TODO FIXME enable this in the end NumberCons(aBasePrecision);
@@ -77,7 +79,7 @@
public Cons copy( Environment aEnvironment, boolean aRecursed) throws Exception {
- NumberCons numberCons = new NumberCons(aEnvironment, iCarBigNumber, iCarStringNumber);
+ NumberCons numberCons = new NumberCons(iCarBigNumber, iCarStringNumber);
numberCons.setMetadataMap(this.getMetadataMap());
@@ -100,7 +102,9 @@
*/
public Object car() throws Exception {
if (iCarStringNumber == null) {
- LispError.lispAssert(iCarBigNumber != null); // either the string is null or the number but not both.
+ //LispError.lispAssert(iCarBigNumber != null, aEnvironment, aStackTop); // either the string is null or the number but not both.
+
+ if(iCarBigNumber == null) throw new EvaluationException("Internal error in NumberCons.","",-1);
iCarStringNumber = iCarBigNumber.numToString(0/*TODO FIXME*/, 10);
// export the current number to string and store it as NumberCons::iString
@@ -108,6 +112,7 @@
return iCarStringNumber;
}
+ @Override
public String toString() {
String stringRepresentation = null;
try {
@@ -128,10 +133,15 @@
* @return
* @throws java.lang.Exception
*/
- public Object getNumber(int aPrecision) throws Exception {
+ @Override
+ public Object getNumber(int aPrecision, Environment aEnvironment) throws Exception {
/// If necessary, will create a BigNumber object out of the stored string, at given precision (in decimal?)
if (iCarBigNumber == null) { // create and store a BigNumber out of the string representation.
- LispError.lispAssert(iCarStringNumber != null);
+
+ //LispError.lispAssert(iCarStringNumber != null, aEnvironment, aStackTop);
+
+ if(iCarStringNumber == null) throw new EvaluationException("Internal error in NumberCons.","",-1);
+
String str;
str = iCarStringNumber;
// aBasePrecision is in digits, not in bits, ok
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/SublistCons.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/SublistCons.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/cons/SublistCons.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/cons/SublistCons.java 2010-12-29 04:07:15.000000000 +0000
@@ -17,6 +17,7 @@
package org.mathpiper.lisp.cons;
+import org.mathpiper.exceptions.EvaluationException;
import org.mathpiper.io.StringOutput;
import org.mathpiper.lisp.*;
import org.mathpiper.lisp.printers.LispPrinter;
@@ -24,10 +25,17 @@
public class SublistCons extends Cons {
- ConsPointer iCar = new ConsPointer();
- ConsPointer iCdr = new ConsPointer();
+ ConsPointer iCar;
+ ConsPointer iCdr;
+ private SublistCons(Environment aEnvironment, Cons aSubList) throws Exception {
+ super();
+ iCar = new ConsPointer();
+ iCar.setCons(aSubList);
+ iCdr = new ConsPointer();
+ }
+
public static SublistCons getInstance(Environment aEnvironment, Cons aSubList) throws Exception {
return new SublistCons(aEnvironment, aSubList);
}
@@ -45,7 +53,9 @@
}*/
public Cons copy(Environment aEnvironment, boolean aRecursed) throws Exception {
//TODO recursed copy needs to be implemented still
- LispError.lispAssert(aRecursed == false);
+ //LispError.lispAssert(aRecursed == false, aEnvironment, aStackTop);
+
+ if(aRecursed != false) throw new EvaluationException("Internal error in SublistCons.","",-1);
Cons copied = new SublistCons(aEnvironment, iCar.getCons());
@@ -55,22 +65,18 @@
}
- SublistCons(Environment aEnvironment, Cons aSubList) throws Exception {
- super(aEnvironment);
- iCar.setCons(aSubList);
- }
-
public ConsPointer cdr() {
return iCdr;
}//end method.
+ @Override
public String toString() {
StringOutput out = new StringOutput();
LispPrinter printer = new LispPrinter();
try {
- printer.print(new ConsPointer(this), out, null);
+ printer.print(-1, new ConsPointer(this), out, null);
} catch (Exception e) {
e.printStackTrace();
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/DefFile.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/DefFile.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/DefFile.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/DefFile.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,39 +13,41 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp;
/** DefFile represents one file that can be loaded just-in-time.
*/
-public class DefFile
-{
- public String iFileName;
- public boolean iIsLoaded;
-
- public DefFile(String aFile)
- {
- iFileName = aFile;
- iIsLoaded = false;
- }
- public DefFile(DefFile aOther)
- {
- iFileName = aOther.iFileName;
- iIsLoaded = aOther.iIsLoaded;
- }
- public void setLoaded()
- {
- iIsLoaded = true;
- }
- public boolean isLoaded()
- {
- return iIsLoaded;
- }
- public String fileName()
- {
- return iFileName;
- }
+public class DefFile {
+
+ public String iFileName;
+ public boolean iIsLoaded;
+
+
+ public DefFile(String aFile) {
+ iFileName = aFile;
+ iIsLoaded = false;
+ }
+
+
+ public DefFile(DefFile aOther) {
+ iFileName = aOther.iFileName;
+ iIsLoaded = aOther.iIsLoaded;
+ }
+
+
+ public void setLoaded() {
+ iIsLoaded = true;
+ }
+
+
+ public boolean isLoaded() {
+ return iIsLoaded;
+ }
+
+
+ public String fileName() {
+ return iFileName;
+ }
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Environment.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Environment.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Environment.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Environment.java 2011-04-24 07:45:56.000000000 +0000
@@ -17,10 +17,12 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp;
+import java.util.HashSet;
import java.util.List;
+import java.util.Set;
import org.mathpiper.lisp.stacks.ArgumentStack;
import org.mathpiper.lisp.collections.DefFileMap;
-import org.mathpiper.lisp.collections.Map;
+import org.mathpiper.lisp.collections.MathPiperMap;
import org.mathpiper.lisp.collections.TokenMap;
import org.mathpiper.lisp.collections.OperatorMap;
import org.mathpiper.lisp.cons.AtomCons;
@@ -35,26 +37,25 @@
import org.mathpiper.io.InputDirectories;
import org.mathpiper.lisp.cons.Cons;
-import org.mathpiper.lisp.cons.SublistCons;
import org.mathpiper.lisp.tokenizers.MathPiperTokenizer;
-import org.mathpiper.lisp.userfunctions.MultipleArityUserFunction;
+import org.mathpiper.lisp.rulebases.MultipleArityRulebase;
-import org.mathpiper.lisp.userfunctions.MacroUserFunction;
+import org.mathpiper.lisp.rulebases.MacroRulebase;
-import org.mathpiper.lisp.userfunctions.ListedBranchingUserFunction;
+import org.mathpiper.lisp.rulebases.ListedRulebase;
-import org.mathpiper.lisp.userfunctions.SingleArityBranchingUserFunction;
+import org.mathpiper.lisp.rulebases.SingleArityRulebase;
-import org.mathpiper.lisp.userfunctions.ListedMacroUserFunction;
+import org.mathpiper.lisp.rulebases.ListedMacroRulebase;
import org.mathpiper.lisp.printers.MathPiperPrinter;
import org.mathpiper.lisp.localvariables.LocalVariable;
import org.mathpiper.lisp.localvariables.LocalVariableFrame;
-public class Environment {
+public final class Environment {
public Evaluator iLispExpressionEvaluator = new LispExpressionEvaluator();
private int iPrecision = 10;
@@ -68,17 +69,19 @@
public Cons iProgOpenAtom;
public Cons iProgCloseAtom;
public Cons iNthAtom;
+ public Cons iComplexAtom;
public Cons iBracketOpenAtom;
public Cons iBracketCloseAtom;
public Cons iListOpenAtom;
public Cons iListCloseAtom;
public Cons iCommaAtom;
public Cons iListAtom;
+ public Cons iSetAtom;
public Cons iProgAtom;
- public OperatorMap iPrefixOperators = new OperatorMap();
- public OperatorMap iInfixOperators = new OperatorMap();
- public OperatorMap iPostfixOperators = new OperatorMap();
- public OperatorMap iBodiedOperators = new OperatorMap();
+ public OperatorMap iPrefixOperators = new OperatorMap(this);
+ public OperatorMap iInfixOperators = new OperatorMap(this);
+ public OperatorMap iPostfixOperators = new OperatorMap(this);
+ public OperatorMap iBodiedOperators = new OperatorMap(this);
public volatile int iEvalDepth = 0;
public int iMaxEvalDepth = 10000;
//TODO FIXME
@@ -94,14 +97,14 @@
public MathPiperTokenizer iCurrentTokenizer;
public MathPiperTokenizer iDefaultTokenizer = new MathPiperTokenizer();
public MathPiperTokenizer iXmlTokenizer = new XmlTokenizer();
- public Map iGlobalState = new Map();
- public Map iUserFunctions = new Map();
- Map iBuiltinFunctions = new Map();
- public String iError = null;
+ public MathPiperMap iGlobalState = new MathPiperMap();
+ public MathPiperMap iUserRules = new MathPiperMap();
+ MathPiperMap iBuiltinFunctions = new MathPiperMap();
+ public Throwable iException = null;
public DefFileMap iDefFiles = new DefFileMap();
public InputDirectories iInputDirectories = new InputDirectories();
- public String iPrettyReader = null;
- public String iPrettyPrinter = null;
+ public String iPrettyReaderName = null;
+ public String iPrettyPrinterName = null;
public Environment(MathPiperOutputStream aCurrentOutput/*TODO FIXME*/) throws Exception {
iCurrentTokenizer = iDefaultTokenizer;
@@ -109,48 +112,46 @@
iCurrentOutput = aCurrentOutput;
iCurrentPrinter = new MathPiperPrinter(iPrefixOperators, iInfixOperators, iPostfixOperators, iBodiedOperators);
- iTrueAtom = AtomCons.getInstance(this, "True");
+ iTrueAtom = new AtomCons((String)getTokenHash().lookUp("True"));
iTrueString = (String) iTrueAtom.car();
- iFalseAtom = AtomCons.getInstance(this, "False");
+ iFalseAtom = new AtomCons((String)getTokenHash().lookUp("False"));
iFalseString = (String) iFalseAtom.car();
- iEndOfFileAtom = AtomCons.getInstance(this, "EndOfFile");
- iEndStatementAtom = AtomCons.getInstance(this, ";");
- iProgOpenAtom = AtomCons.getInstance(this, "[");
- iProgCloseAtom = AtomCons.getInstance(this, "]");
- iNthAtom = AtomCons.getInstance(this, "Nth");
- iBracketOpenAtom = AtomCons.getInstance(this, "(");
- iBracketCloseAtom = AtomCons.getInstance(this, ")");
- iListOpenAtom = AtomCons.getInstance(this, "{");
- iListCloseAtom = AtomCons.getInstance(this, "}");
- iCommaAtom = AtomCons.getInstance(this, ",");
- iListAtom = AtomCons.getInstance(this, "List");
- iProgAtom = AtomCons.getInstance(this, "Prog");
+ iEndOfFileAtom = new AtomCons((String)getTokenHash().lookUp("EndOfFile"));
+ iEndStatementAtom = new AtomCons((String)getTokenHash().lookUp(";"));
+ iProgOpenAtom = new AtomCons((String)getTokenHash().lookUp("["));
+ iProgCloseAtom = new AtomCons((String)getTokenHash().lookUp("]"));
+ iNthAtom = new AtomCons((String)getTokenHash().lookUp("Nth"));
+ iComplexAtom = new AtomCons((String)getTokenHash().lookUp("Complex"));
+ iBracketOpenAtom = new AtomCons((String)getTokenHash().lookUp("("));
+ iBracketCloseAtom = new AtomCons((String)getTokenHash().lookUp(")"));
+ iListOpenAtom = new AtomCons((String)getTokenHash().lookUp("{"));
+ iListCloseAtom = new AtomCons((String)getTokenHash().lookUp("}"));
+ iCommaAtom = new AtomCons((String)getTokenHash().lookUp(","));
+ iListAtom = new AtomCons((String)getTokenHash().lookUp("List"));
+ iSetAtom = new AtomCons((String)getTokenHash().lookUp("Set"));
+ iProgAtom = new AtomCons((String)getTokenHash().lookUp("Prog"));
- iArgumentStack = new ArgumentStack(50000 /*TODO FIXME*/);
+ iArgumentStack = new ArgumentStack(this, 50000 /*TODO FIXME*/);
//org.mathpiper.builtin.Functions mc = new org.mathpiper.builtin.Functions();
//mc.addCoreFunctions(this);
//System.out.println("Classpath: " + System.getProperty("java.class.path"));
- BuiltinFunction.addCoreFunctions(this);
- List failList = BuiltinFunction.addOptionalFunctions(this, "org/mathpiper/builtin/functions/optional/");
-
- pushLocalFrame(true, "");
}
public TokenMap getTokenHash() {
return iTokenHash;
}
- public Map getGlobalState() {
+ public MathPiperMap getGlobalState() {
return iGlobalState;
}
- public Map getUserFunctions() {
- return iUserFunctions;
+ public MathPiperMap getUserFunctions() {
+ return iUserRules;
}
- public Map getBuiltinFunctions() {
+ public MathPiperMap getBuiltinFunctions() {
return iBuiltinFunctions;
}
@@ -162,22 +163,22 @@
iPrecision = aPrecision; // getPrecision in decimal digits
}
- public void setGlobalVariable(String aVariable, ConsPointer aValue, boolean aGlobalLazyVariable) throws Exception {
- ConsPointer localVariable = getLocalVariable(aVariable);
+ public void setGlobalVariable(int aStackTop, String aVariable, ConsPointer aValue, boolean aGlobalLazyVariable) throws Exception {
+ ConsPointer localVariable = getLocalVariable(aStackTop, aVariable);
if (localVariable != null) {
localVariable.setCons(aValue.getCons());
return;
}
- GlobalVariable globalVariable = new GlobalVariable(aValue);
+ GlobalVariable globalVariable = new GlobalVariable(this,aValue);
iGlobalState.setAssociation(globalVariable, aVariable);
if (aGlobalLazyVariable) {
globalVariable.setEvalBeforeReturn(true);
}
}
- public void getGlobalVariable(String aVariable, ConsPointer aResult) throws Exception {
+ public void getGlobalVariable(int aStackTop, String aVariable, ConsPointer aResult) throws Exception {
aResult.setCons(null);
- ConsPointer localVariable = getLocalVariable(aVariable);
+ ConsPointer localVariable = getLocalVariable(aStackTop, aVariable);
if (localVariable != null) {
aResult.setCons(localVariable.getCons());
return;
@@ -185,7 +186,7 @@
GlobalVariable globalVariable = (GlobalVariable) iGlobalState.lookUp(aVariable);
if (globalVariable != null) {
if (globalVariable.iEvalBeforeReturn) {
- iLispExpressionEvaluator.evaluate(this, aResult, globalVariable.iValue);
+ iLispExpressionEvaluator.evaluate(this, aStackTop, aResult, globalVariable.iValue);
globalVariable.iValue.setCons(aResult.getCons());
globalVariable.iEvalBeforeReturn = false;
return;
@@ -197,21 +198,37 @@
}
- public ConsPointer getLocalVariable(String aVariable) throws Exception {
- LispError.check(iLocalVariablesFrame != null, LispError.INVALID_STACK);
+ public ConsPointer getLocalVariable(int aStackTop, String aVariable) throws Exception {
+ LispError.check(this, aStackTop, iLocalVariablesFrame != null, LispError.INVALID_STACK, "INTERNAL");
// check(iLocalsList.iFirst != null,INVALID_STACK);
LocalVariable localVariable = iLocalVariablesFrame.iFirst;
while (localVariable != null) {
- if (localVariable.iVariable == aVariable) {
+ if (localVariable.iVariable.equals(aVariable)) {
return localVariable.iValue;
}
localVariable = localVariable.iNext;
}
return null;
}//end method.
- public String getLocalVariables() throws Exception {
- LispError.check(iLocalVariablesFrame != null, LispError.INVALID_STACK);
+
+
+
+ public void unbindAllLocalVariables(int aStackTop) throws Exception{
+ LispError.check(this, aStackTop, iLocalVariablesFrame != null, LispError.INVALID_STACK, "INTERNAL");
+
+ LocalVariable localVariable = iLocalVariablesFrame.iFirst;
+
+ while (localVariable != null) {
+ localVariable.iValue.setCons(null);
+ localVariable = localVariable.iNext;
+ }
+
+ }//end method.
+
+
+ public String getLocalVariables(int aStackTop) throws Exception {
+ LispError.check(this, aStackTop, iLocalVariablesFrame != null, LispError.INVALID_STACK, "INTERNAL");
// check(iLocalsList.iFirst != null,INVALID_STACK);
LocalVariable localVariable = iLocalVariablesFrame.iFirst;
@@ -244,19 +261,185 @@
}//end method.
- public void unbindVariable(String aVariableName) throws Exception {
- ConsPointer localVariable = getLocalVariable(aVariableName);
- if (localVariable != null) {
- localVariable.setCons(null);
- return;
+
+ public String dumpLocalVariablesFrame(int aStackTop) throws Exception {
+
+ LispError.check(this, aStackTop, iLocalVariablesFrame != null, LispError.INVALID_STACK, "INTERNAL");
+
+ LocalVariableFrame localVariableFramePointer = iLocalVariablesFrame;
+
+ StringBuilder stringBuilder = new StringBuilder();
+
+
+
+ int functionPositionIndex = 0;
+
+ //int functionBaseIndex = 0;
+
+ while (localVariableFramePointer != null) {
+
+ String functionName = localVariableFramePointer.getFunctionName();
+
+
+ if(functionPositionIndex == 0)
+ {
+ stringBuilder.append("\n\n========================================= Start Of User Function Stack Trace\n");
+ }
+ else
+ {
+ stringBuilder.append("-----------------------------------------\n");
+ }
+
+
+ stringBuilder.append(functionPositionIndex++ + ": ");
+ stringBuilder.append(functionName);
+ stringBuilder.append("\n");
+
+ LocalVariable localVariable = localVariableFramePointer.iFirst;
+
+
+ //stringBuilder.append("Local variables: ");
+
+
+ while (localVariable != null) {
+
+
+ stringBuilder.append(" " + functionPositionIndex++ + ": -> ");
+
+ stringBuilder.append(localVariable.iVariable);
+
+ stringBuilder.append(" = ");
+
+ ConsPointer valuePointer = localVariable.iValue;
+
+ String valueString = Utility.printMathPiperExpression(aStackTop, valuePointer, this, -1);
+
+ stringBuilder.append(valueString);
+
+ stringBuilder.append("\n");
+
+
+
+
+ /*if(value != null)
+ {
+ localVariablesStringBuilder.append(value.trim().replace(" ","").replace("\n", "") );
+ }
+ else
+ {
+ localVariablesStringBuilder.append("unbound");
+ }//end else.
+
+
+ localVariablesStringBuilder.append(", ");*/
+
+ localVariable = localVariable.iNext;
+ }//end while.
+
+ localVariableFramePointer = localVariableFramePointer.iNext;
+
+ }//end while
+
+ stringBuilder.append("========================================= End Of User Function Stack Trace\n\n");
+
+ return stringBuilder.toString();
+
+
+
+
+ /*StringBuilder stringBuilder = new StringBuilder();
+
+ int functionBaseIndex = 0;
+
+ int functionPositionIndex = 0;
+
+
+ while (functionBaseIndex <= aStackTop) {
+
+ if(functionBaseIndex == 0)
+ {
+ stringBuilder.append("\n\n========================================= Start Of Stack Trace\n");
+ }
+ else
+ {
+ stringBuilder.append("-----------------------------------------\n");
+ }
+
+ ConsPointer consPointer = getElement(functionBaseIndex, aStackTop, aEnvironment);
+
+ int argumentCount = Utility.listLength(aEnvironment, aStackTop, consPointer);
+
+ ConsPointer argumentPointer = new ConsPointer();
+
+ Object car = consPointer.getCons().car();
+
+ ConsPointer consTraverser = new ConsPointer( consPointer.getCons());
+
+ stringBuilder.append(functionPositionIndex++ + ": ");
+ stringBuilder.append(Utility.printMathPiperExpression(aStackTop, consTraverser, aEnvironment, -1));
+ stringBuilder.append("\n");
+
+ consTraverser.goNext(aStackTop, aEnvironment);
+
+ while(consTraverser.getCons() != null)
+ {
+ stringBuilder.append(" " + functionPositionIndex++ + ": ");
+ stringBuilder.append("-> " + Utility.printMathPiperExpression(aStackTop, consTraverser, aEnvironment, -1));
+ stringBuilder.append("\n");
+
+ consTraverser.goNext(aStackTop, aEnvironment);
+ }
+
+
+ functionBaseIndex = functionBaseIndex + argumentCount;
+
+ }//end while.
+
+ stringBuilder.append("========================================= End Of User Function Stack Trace\n\n");
+
+ return stringBuilder.toString();*/
+
+ }//end method.
+
+ public void unbindVariable(int aStackTop, String aVariableName) throws Exception {
+
+ if(aVariableName.equals("*"))
+ {
+ this.unbindAllLocalVariables(aStackTop);
+
+
+ //Unbind global variables
+ Set keySet = new HashSet(iGlobalState.getMap().keySet());
+
+ for(String key : keySet)
+ {
+ if(!key.startsWith("$")
+ && !key.equals("I")
+ && !key.equals("%")
+ && !key.equals("geogebra"))
+ {
+ //Do not unbind private variables (which are those which start with a $) or the other listed variables.
+ iGlobalState.release(key);
+ }
+ }
}
- iGlobalState.release(aVariableName);
+ else
+ {
+ //Unbind local variable.
+ ConsPointer localVariable = getLocalVariable(aStackTop, aVariableName);
+ if (localVariable != null) {
+ localVariable.setCons(null);
+ return;
+ }
+
+ iGlobalState.release(aVariableName);
+ }//end else.
}
- public void newLocalVariable(String aVariable, Cons aValue) throws Exception {
- LispError.lispAssert(iLocalVariablesFrame != null);
- iLocalVariablesFrame.add(new LocalVariable(aVariable, aValue));
+ public void newLocalVariable(String aVariable, Cons aValue, int aStackTop) throws Exception {
+ LispError.lispAssert(iLocalVariablesFrame != null, this, aStackTop);
+ iLocalVariablesFrame.add(new LocalVariable(this, aVariable, aValue));
}
public void pushLocalFrame(boolean aFenced, String functionName) {
@@ -269,8 +452,8 @@
}
}
- public void popLocalFrame() throws Exception {
- LispError.lispAssert(iLocalVariablesFrame != null);
+ public void popLocalFrame(int aStackTop) throws Exception {
+ LispError.lispAssert(iLocalVariablesFrame != null, this, aStackTop);
LocalVariableFrame nextLocalVariableFrame = iLocalVariablesFrame.iNext;
iLocalVariablesFrame.delete();
iLocalVariablesFrame = nextLocalVariableFrame;
@@ -280,117 +463,115 @@
return iLastUniqueId++;
}
- public void holdArgument(String aOperator, String aVariable) throws Exception {
- MultipleArityUserFunction multipleArityUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
- LispError.check(multipleArityUserFunc != null, LispError.INVALID_ARGUMENT);
- multipleArityUserFunc.holdArgument(aVariable);
+ public void holdArgument(int aStackTop, String aOperator, String aVariable, Environment aEnvironment) throws Exception {
+ MultipleArityRulebase multipleArityUserFunc = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
+ LispError.check(this, aStackTop, multipleArityUserFunc != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ multipleArityUserFunc.holdArgument(aVariable, aStackTop, aEnvironment);
}
- public void retractFunction(String aOperator, int aArity) throws Exception {
- MultipleArityUserFunction multipleArityUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
+ public void retractRule(String aOperator, int aArity, int aStackTop, Environment aEnvironment) throws Exception {
+ MultipleArityRulebase multipleArityUserFunc = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
if (multipleArityUserFunc != null) {
- multipleArityUserFunc.deleteRulebaseEntry(aArity);
+ multipleArityUserFunc.deleteRulebaseEntry(aArity, aStackTop, aEnvironment);
}
}
- public SingleArityBranchingUserFunction getUserFunction(ConsPointer aArguments) throws Exception {
- MultipleArityUserFunction multipleArityUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp( (String) aArguments.car());
+ public SingleArityRulebase getRulebase(int aStackTop, ConsPointer aArguments) throws Exception {
+ MultipleArityRulebase multipleArityUserFunc = (MultipleArityRulebase) iUserRules.lookUp( (String) aArguments.car());
if (multipleArityUserFunc != null) {
- int arity = Utility.listLength(aArguments) - 1;
- return multipleArityUserFunc.getUserFunction(arity);
+ int arity = Utility.listLength(this, aStackTop, aArguments) - 1;
+ return multipleArityUserFunc.getUserFunction(arity, aStackTop, this);
}
return null;
}
- public SingleArityBranchingUserFunction getUserFunction(String aName, int aArity) throws Exception {
- MultipleArityUserFunction multipleArityUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp(aName);
+ public SingleArityRulebase getRulebase(String aName, int aArity, int aStackTop) throws Exception {
+ MultipleArityRulebase multipleArityUserFunc = (MultipleArityRulebase) iUserRules.lookUp(aName);
if (multipleArityUserFunc != null) {
- return multipleArityUserFunc.getUserFunction(aArity);
+ return multipleArityUserFunc.getUserFunction(aArity, aStackTop, this);
}
return null;
}
- public void unFenceRule(String aOperator, int aArity) throws Exception {
- MultipleArityUserFunction multiUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
+ public void unfenceRule(int aStackTop, String aOperator, int aArity) throws Exception {
+ MultipleArityRulebase multiUserFunc = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
- LispError.check(multiUserFunc != null, LispError.INVALID_ARGUMENT);
- SingleArityBranchingUserFunction userFunc = multiUserFunc.getUserFunction(aArity);
- LispError.check(userFunc != null, LispError.INVALID_ARGUMENT);
+ LispError.check(this, aStackTop, multiUserFunc != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ SingleArityRulebase userFunc = multiUserFunc.getUserFunction(aArity, aStackTop, this);
+ LispError.check(this, aStackTop, userFunc != null, LispError.INVALID_ARGUMENT, "INTERNAL");
userFunc.unFence();
}
- public MultipleArityUserFunction getMultipleArityUserFunction(String aOperator, boolean create) throws Exception {
+ public MultipleArityRulebase getMultipleArityRulebase(int aStackTop, String aOperator, boolean create) throws Exception {
// Find existing multiuser func. Todo:tk:a user function name is added to the list even if a non-existing function
// is being executed or looked for by FindFunction();
- MultipleArityUserFunction multipleArityUserFunction = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
+ MultipleArityRulebase multipleArityUserFunction = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
// If none exists, add one to the user functions list
if (multipleArityUserFunction == null && create == true) {
- MultipleArityUserFunction newMultipleArityUserFunction = new MultipleArityUserFunction();
- iUserFunctions.setAssociation(newMultipleArityUserFunction, aOperator);
- multipleArityUserFunction = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
- LispError.check(multipleArityUserFunction != null, LispError.CREATING_USER_FUNCTION);
+ MultipleArityRulebase newMultipleArityUserFunction = new MultipleArityRulebase();
+ iUserRules.setAssociation(newMultipleArityUserFunction, aOperator);
+ multipleArityUserFunction = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
+ LispError.check(this, aStackTop, multipleArityUserFunction != null, LispError.CREATING_USER_FUNCTION, "INTERNAL");
}
return multipleArityUserFunction;
}
- public void declareRulebase(String aOperator, ConsPointer aParametersPointer, boolean aListed) throws Exception {
- MultipleArityUserFunction multipleArityUserFunction = getMultipleArityUserFunction(aOperator, true);
+ public void defineRulebase(int aStackTop, String aOperator, ConsPointer aParametersPointer, boolean aListed) throws Exception {
+ MultipleArityRulebase multipleArityUserFunction = getMultipleArityRulebase(aStackTop, aOperator, true);
// add an operator with this arity to the multiuserfunc.
- SingleArityBranchingUserFunction newBranchingUserFunction;
+ SingleArityRulebase newBranchingRulebase;
if (aListed) {
- newBranchingUserFunction = new ListedBranchingUserFunction(aParametersPointer, aOperator);
+ newBranchingRulebase = new ListedRulebase(this, aStackTop, aParametersPointer, aOperator);
} else {
- newBranchingUserFunction = new SingleArityBranchingUserFunction(aParametersPointer, aOperator);
+ newBranchingRulebase = new SingleArityRulebase(this, aStackTop, aParametersPointer, aOperator);
}
- multipleArityUserFunction.addRulebaseEntry(newBranchingUserFunction);
+ multipleArityUserFunction.addRulebaseEntry(this, aStackTop, newBranchingRulebase);
}
- public void defineRule(String aOperator, int aArity,
- int aPrecedence, ConsPointer aPredicate,
- ConsPointer aBody) throws Exception {
- // Find existing multiuser func.
- MultipleArityUserFunction multipleArityUserFunction = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
- LispError.check(multipleArityUserFunction != null, LispError.CREATING_RULE);
+ public void defineRule(int aStackTop, String aOperator, int aArity, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
+ // Find existing multiuser rule.
+ MultipleArityRulebase multipleArityRulebase = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
+ LispError.check(this, aStackTop, multipleArityRulebase != null, LispError.CREATING_RULE, "INTERNAL");
// Get the specific user function with the right arity
- SingleArityBranchingUserFunction userFunction = (SingleArityBranchingUserFunction) multipleArityUserFunction.getUserFunction(aArity);
- LispError.check(userFunction != null, LispError.CREATING_RULE);
+ SingleArityRulebase rulebase = (SingleArityRulebase) multipleArityRulebase.getUserFunction(aArity, aStackTop, this);
+ LispError.check(this, aStackTop, rulebase != null, LispError.CREATING_RULE, "INTERNAL");
// Declare a new evaluation rule
- if (Utility.isTrue(this, aPredicate)) {
+ if (Utility.isTrue(this, aPredicate, aStackTop)) {
// printf("FastPredicate on %s\n",aOperator->String());
- userFunction.declareRule(aPrecedence, aBody);
+ rulebase.defineAlwaysTrueRule(aStackTop, aPrecedence, aBody);
} else {
- userFunction.declareRule(aPrecedence, aPredicate, aBody);
+ rulebase.defineSometimesTrueRule(aStackTop, aPrecedence, aPredicate, aBody);
}
}
- public void declareMacroRulebase(String aFunctionName, ConsPointer aParameters, boolean aListed) throws Exception {
- MultipleArityUserFunction multipleArityUserFunc = getMultipleArityUserFunction(aFunctionName, true);
+ public void defineMacroRulebase(int aStackTop, String aFunctionName, ConsPointer aParameters, boolean aListed) throws Exception {
+ MultipleArityRulebase multipleArityRulebase = getMultipleArityRulebase(aStackTop, aFunctionName, true);
- MacroUserFunction newMacroUserFunction;
+ MacroRulebase newMacroRulebase;
if (aListed) {
- newMacroUserFunction = new ListedMacroUserFunction(aParameters, aFunctionName);
+ newMacroRulebase = new ListedMacroRulebase(this, aStackTop, aParameters, aFunctionName);
} else {
- newMacroUserFunction = new MacroUserFunction(aParameters, aFunctionName);
+ newMacroRulebase = new MacroRulebase(this, aStackTop, aParameters, aFunctionName);
}
- multipleArityUserFunc.addRulebaseEntry(newMacroUserFunction);
+ multipleArityRulebase.addRulebaseEntry(this, aStackTop, newMacroRulebase);
}
- public void defineRulePattern(String aOperator, int aArity, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
- // Find existing multiuser func.
- MultipleArityUserFunction multipleArityUserFunc = (MultipleArityUserFunction) iUserFunctions.lookUp(aOperator);
- LispError.check(multipleArityUserFunc != null, LispError.CREATING_RULE);
+ public void defineRulePattern(int aStackTop, String aOperator, int aArity, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
+ // Find existing multiuser rulebase.
+ MultipleArityRulebase multipleArityRulebase = (MultipleArityRulebase) iUserRules.lookUp(aOperator);
+ LispError.check(this, aStackTop, multipleArityRulebase != null, LispError.CREATING_RULE, "INTERNAL");
// Get the specific user function with the right arity
- SingleArityBranchingUserFunction userFunction = multipleArityUserFunc.getUserFunction(aArity);
- LispError.check(userFunction != null, LispError.CREATING_RULE);
+ SingleArityRulebase rulebase = multipleArityRulebase.getUserFunction(aArity, aStackTop, this);
+ LispError.check(this, aStackTop, rulebase != null, LispError.CREATING_RULE, "INTERNAL");
// Declare a new evaluation rule
- userFunction.declarePattern(aPrecedence, aPredicate, aBody);
+ rulebase.definePattern(aStackTop, aPrecedence, aPredicate, aBody);
}
/**
@@ -404,9 +585,9 @@
- public void resetArgumentStack() throws Exception
+ public void resetArgumentStack(int aStackTop) throws Exception
{
- this.iArgumentStack.reset();
+ this.iArgumentStack.reset(aStackTop, this);
}//end method.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Evaluator.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Evaluator.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Evaluator.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Evaluator.java 2010-12-29 04:07:15.000000000 +0000
@@ -24,7 +24,6 @@
import org.mathpiper.io.MathPiperOutputStream;
import org.mathpiper.io.StringOutputStream;
import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
import org.mathpiper.lisp.localvariables.LocalVariableFrame;
import org.mathpiper.lisp.printers.MathPiperPrinter;
import org.mathpiper.lisp.stacks.UserStackInformation;
@@ -39,6 +38,7 @@
public static boolean iTraced = false;
private static List traceFunctionList = null;
private static List traceExceptFunctionList = null;
+ public static boolean iStackTraced = false;
UserStackInformation iBasicInfo = new UserStackInformation();
public static void showExpression(StringBuffer outString, Environment aEnvironment, ConsPointer aExpression) throws Exception {
@@ -46,7 +46,7 @@
// Print out the current expression
//StringOutput stream(outString);
MathPiperOutputStream stream = new StringOutputStream(outString);
- infixprinter.print(aExpression, stream, aEnvironment);
+ infixprinter.print(-1, aExpression, stream, aEnvironment);
// Escape quotes.
for (int i = outString.length() - 1; i >= 0; --i) {
char c = outString.charAt(i);
@@ -264,7 +264,19 @@
iTraced = true;
}
- public abstract void evaluate(Environment aEnvironment, ConsPointer aResult, ConsPointer aArgumentsOrExpression) throws Exception;
+ public static boolean isStackTraced() {
+ return iStackTraced;
+ }
+
+ public static void stackTraceOff() {
+ iStackTraced = false;
+ }
+
+ public static void stackTraceOn() {
+ iStackTraced = true;
+ }
+
+ public abstract void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArgumentsOrExpression) throws Exception;
public UserStackInformation stackInformation() {
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/GlobalVariable.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/GlobalVariable.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/GlobalVariable.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/GlobalVariable.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,57 +13,60 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp;
import org.mathpiper.lisp.cons.ConsPointer;
-
-
-
/**
* Value of a Lisp global variable.
-* The only special feature of this class is the attribute
-* iEvalBeforeReturn, which defaults to LispFalse. If this
-* attribute is set to LispTrue, the value in iValue needs to be
-* evaluated to get the value of the Lisp variable.
-* See: LispEnvironment::GetVariable()
+ * The only special feature of this class is the attribute
+ * iEvalBeforeReturn, which defaults to LispFalse. If this
+ * attribute is set to LispTrue, the value in iValue needs to be
+ * evaluated to get the value of the Lisp variable.
+ * See: LispEnvironment::GetVariable()
*/
-public class GlobalVariable
-{
- ConsPointer iValue = new ConsPointer();
- boolean iEvalBeforeReturn;
-
- public GlobalVariable(GlobalVariable aOther)
- {
- iValue = aOther.iValue;
- iEvalBeforeReturn = aOther.iEvalBeforeReturn;
- }
- public GlobalVariable(ConsPointer aValue)
- {
- iValue.setCons(aValue.getCons());
- iEvalBeforeReturn = false;
- }
- public void setEvalBeforeReturn(boolean aEval)
- {
- iEvalBeforeReturn = aEval;
- }
-
- public String toString()
- {
- return (String) iValue.getCons().toString();
- }
+public class GlobalVariable {
+
+ ConsPointer iValue;
+ boolean iEvalBeforeReturn;
+ private Environment iEnvironment;
+
+
+ public GlobalVariable(Environment aEnvironment, GlobalVariable aOther) {
+ iEnvironment = aEnvironment;
+ iValue = new ConsPointer();
+ iValue = aOther.iValue;
+ iEvalBeforeReturn = aOther.iEvalBeforeReturn;
+ }
+
+
+ public GlobalVariable(Environment aEnvironment, ConsPointer aValue) {
+ iEnvironment = aEnvironment;
+ iValue = new ConsPointer();
+ iValue.setCons(aValue.getCons());
+ iEvalBeforeReturn = false;
+ }
+
+
+ public void setEvalBeforeReturn(boolean aEval) {
+ iEvalBeforeReturn = aEval;
+ }
+
+
+ @Override
+ public String toString() {
+ return (String) iValue.getCons().toString();
+ }
+
public boolean isIEvalBeforeReturn() {
return iEvalBeforeReturn;
}
+
public ConsPointer getValue() {
return iValue;
}
-
-
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/InfixOperator.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/InfixOperator.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/InfixOperator.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/InfixOperator.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp;
-
-
-public class InfixOperator
-{
- public int iPrecedence;
- public int iLeftPrecedence;
- public int iRightPrecedence;
- public int iRightAssociative;
-
- public InfixOperator(int aPrecedence)
- {
- iPrecedence = aPrecedence;
- iLeftPrecedence = aPrecedence;
- iRightPrecedence = aPrecedence;
- iRightAssociative = 0;
- }
-
- public void setRightAssociative()
- {
- iRightAssociative = 1;
- }
-
- public void setLeftPrecedence(int aPrecedence)
- {
- iLeftPrecedence = aPrecedence;
- }
-
- public void setRightPrecedence(int aPrecedence)
- {
- iRightPrecedence = aPrecedence;
- }
-
-}
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/LispError.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/LispError.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/LispError.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/LispError.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,7 +13,6 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp;
@@ -21,9 +20,9 @@
import org.mathpiper.exceptions.EvaluationException;
import org.mathpiper.builtin.BuiltinFunction;
+public class LispError {
-public class LispError
-{
+ public static final int TODO = -1;
public static final int NONE = 0;
public static final int INVALID_ARGUMENT = 1;
public static final int WRONG_NUMBER_OF_ARGUMENTS = 2;
@@ -55,288 +54,302 @@
public static final int NON_BOOLEAN_PREDICATE_IN_PATTERN = 28;
public static final int GENERIC_FORMAT = 29;
public static final int LIST_LENGTHS_MUST_BE_EQUAL = 30;
-
public static final int MAXIMUM_NUMBER_OF_ERRORS = 31;
-
- public static String errorString(int aError) throws Exception
- {
- lispAssert(aError >= 0 && aError < MAXIMUM_NUMBER_OF_ERRORS);
+ public static String errorString(int aError) throws Exception {
+ //lispAssert(aError >= 0 && aError < MAXIMUM_NUMBER_OF_ERRORS, aEnvironment, aStackTop);
+
+ if (aError < 0 || aError >= MAXIMUM_NUMBER_OF_ERRORS) {
+ throw new EvaluationException("Maximum number of errors exceeded.", "", -1);
+ }
+
+
// switch (aError)
{
- if (aError == NONE)
- {
+ if (aError == NONE) {
return "No error.";
}
- if (aError == INVALID_ARGUMENT)
- {
+ if (aError == INVALID_ARGUMENT) {
return "Invalid argument.";
}
- if (aError == WRONG_NUMBER_OF_ARGUMENTS)
- {
+ if (aError == WRONG_NUMBER_OF_ARGUMENTS) {
return "Wrong number of arguments.";
}
- if (aError == NOT_A_LIST)
- {
+ if (aError == NOT_A_LIST) {
return "Argument is not a list.";
}
- if (aError == NOT_LONG_ENOUGH)
- {
+ if (aError == NOT_LONG_ENOUGH) {
return "List not long enough.";
}
- if (aError == INVALID_STACK)
- {
+ if (aError == INVALID_STACK) {
return "Invalid stack.";
}
- if (aError == QUITTING)
- {
+ if (aError == QUITTING) {
return "Quitting...";
}
- if (aError == NOT_ENOUGH_MEMORY)
- {
+ if (aError == NOT_ENOUGH_MEMORY) {
return "Not enough memory.";
}
- if (aError == INVALID_TOKEN)
- {
+ if (aError == INVALID_TOKEN) {
return "Empty token during parsing.";
}
- if (aError == INVALID_EXPRESSION)
- {
+ if (aError == INVALID_EXPRESSION) {
return "Error parsing expression.";
}
- if (aError == UNPRINTABLE_TOKEN)
- {
+ if (aError == UNPRINTABLE_TOKEN) {
return "Unprintable atom.";
}
- if (aError == FILE_NOT_FOUND)
- {
+ if (aError == FILE_NOT_FOUND) {
return "File not found.";
}
- if (aError == READING_FILE)
- {
+ if (aError == READING_FILE) {
return "Error reading file.";
}
- if (aError == CREATING_USER_FUNCTION)
- {
+ if (aError == CREATING_USER_FUNCTION) {
return "Could not create user function.";
}
- if (aError == CREATING_RULE)
- {
+ if (aError == CREATING_RULE) {
return "Could not create rule.";
}
- if (aError == ARITY_ALREADY_DEFINED)
- {
+ if (aError == ARITY_ALREADY_DEFINED) {
return "Rule base with this arity already defined.";
}
- if (aError == COMMENT_TO_END_OF_FILE)
- {
+ if (aError == COMMENT_TO_END_OF_FILE) {
return "Reaching end of file within a comment block.";
}
- if (aError == NOT_A_STRING)
- {
+ if (aError == NOT_A_STRING) {
return "Argument is not a string.";
}
- if (aError == NOT_AN_INTEGER)
- {
+ if (aError == NOT_AN_INTEGER) {
return "Argument is not an integer.";
}
- if (aError == PARSING_INPUT)
- {
+ if (aError == PARSING_INPUT) {
return "Error while parsing input.";
}
- if (aError == MAXIMUM_RECURSE_DEPTH_REACHED)
- {
+ if (aError == MAXIMUM_RECURSE_DEPTH_REACHED) {
return "Max evaluation stack depth reached.\nPlease use MaxEvalDepth to increase the stack size as needed.";
}
- if (aError == DEF_FILE_ALREADY_CHOSEN)
- {
+ if (aError == DEF_FILE_ALREADY_CHOSEN) {
return "DefFile already chosen for function.";
}
- if (aError == DIVIDE_BY_ZERO)
- {
+ if (aError == DIVIDE_BY_ZERO) {
return "Divide by zero.";
}
- if (aError == NOT_AN_INFIX_OPERATOR)
- {
+ if (aError == NOT_AN_INFIX_OPERATOR) {
return "Trying to make a non-infix operator right-associative.";
}
- if (aError == IS_NOT_INFIX)
- {
+ if (aError == IS_NOT_INFIX) {
return "Trying to get precedence of non-infix operator.";
}
- if (aError == SECURITY_BREACH)
- {
+ if (aError == SECURITY_BREACH) {
return "Trying to perform an insecure action.";
}
- if (aError == LIBRARY_NOT_FOUND)
- {
+ if (aError == LIBRARY_NOT_FOUND) {
return "Could not find library.";
}
- if (aError == USER_INTERRUPT)
- {
+ if (aError == USER_INTERRUPT) {
return "User halted calculation.";
}
- if (aError == NON_BOOLEAN_PREDICATE_IN_PATTERN)
- {
+ if (aError == NON_BOOLEAN_PREDICATE_IN_PATTERN) {
return "Predicate doesn't evaluate to a boolean in pattern.";
}
- if (aError == GENERIC_FORMAT)
- {
+ if (aError == GENERIC_FORMAT) {
return "Generic format.";
}
- if (aError == LIST_LENGTHS_MUST_BE_EQUAL)
- {
+ if (aError == LIST_LENGTHS_MUST_BE_EQUAL) {
return "List lengths must be equal.";
}
}
return "Unspecified Error.";
}
- public static void check(boolean hastobetrue, int aError) throws Exception
- {
- if (!hastobetrue)
- {
- String errorMessage = errorString(aError);//"LispError number "+aError+" (//TODO FIXME still need to port over the string table)";
- throw new EvaluationException(errorMessage,-1);
+
+ public static void check(Environment aEnvironment, int aStackTop, boolean hastobetrue, int aError, String functionName) throws Exception {
+ if (!hastobetrue) {
+ String errorMessage = errorString(aError);// + " In function " + functionName + ". ";
+
+ check(hastobetrue, errorMessage, functionName, aStackTop, aEnvironment);
+
}
}//end method.
- public static void check(boolean hastobetrue, String aErrorMessage) throws Exception
- {
- if (!hastobetrue)
- {
- throw new EvaluationException(aErrorMessage,-1);
+ public static void check(boolean predicate, String aErrorMessage, String functionName, int aStackTop, Environment aEnvironment) throws Exception {
+ if (!predicate) {
+ String stackTrace = "";
+
+ if (Evaluator.isStackTraced() && aStackTop >= 0) {
+ stackTrace = aEnvironment.iArgumentStack.dump(aStackTop, aEnvironment);
+
+ stackTrace = stackTrace + aEnvironment.dumpLocalVariablesFrame(aStackTop);
+ }
+
+
+ if (aStackTop == -1) {
+ throw new EvaluationException("Error encountered during initialization or parsing: " + aErrorMessage + stackTrace, "none", -1);
+ } else if (aStackTop == -2) {
+ throw new EvaluationException("Error: " + aErrorMessage + stackTrace, "none", -1);
+ } else {
+ ConsPointer arguments = BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 0);
+ if (arguments.getCons() == null) {
+ throw new EvaluationException("Error in compiled code." + stackTrace, "none", -1);
+ } else {
+ //TODO FIXME ShowStack(aEnvironment);
+ aErrorMessage = aErrorMessage + " " + showFunctionError(arguments, aEnvironment) + "internal.";
+ }
+
+
+ throw new EvaluationException(aErrorMessage /*+ " In function " + functionName + ". " */ + stackTrace, "none", -1);
+
+ }
}
}//end method.
-
- public static void raiseError(String str) throws Exception
- {
- throw new EvaluationException(str,-1);
+
+ public static void raiseError(String errorMessage, String functionName, int aStackTop, Environment aEnvironment) throws Exception {
+ check(false, errorMessage, functionName, aStackTop, aEnvironment);
+ //throw new EvaluationException(errorMessage + " In function " + functionName + ". ","none",-1);
}
- public static void checkNumberOfArguments(int n, ConsPointer aArguments, Environment aEnvironment) throws Exception
- {
- int nrArguments = Utility.listLength(aArguments);
- if (nrArguments != n)
- {
- errorNumberOfArguments(n - 1, nrArguments - 1, aArguments, aEnvironment);
+
+ public static void checkNumberOfArguments(int aStackTop, int n, ConsPointer aArguments, Environment aEnvironment, String functionName) throws Exception {
+ int nrArguments = Utility.listLength(aEnvironment, aStackTop, aArguments);
+ if (nrArguments != n) {
+ errorNumberOfArguments(n - 1, nrArguments - 1, aArguments, aEnvironment, functionName, aStackTop);
}
}
- public static void errorNumberOfArguments(int needed, int passed, ConsPointer aArguments, Environment aEnvironment) throws Exception
- {
- if (aArguments.getCons() == null)
- {
- throw new EvaluationException("Error in compiled code.",-1);
- } else
- {
+
+ public static void errorNumberOfArguments(int needed, int passed, ConsPointer aArguments, Environment aEnvironment, String functionName, int aStackTop) throws Exception {
+ String stackTrace = "";
+
+ if (Evaluator.isStackTraced() && aStackTop >= 0) {
+ stackTrace = aEnvironment.iArgumentStack.dump(aStackTop, aEnvironment);
+
+ stackTrace = stackTrace + aEnvironment.dumpLocalVariablesFrame(aStackTop);
+ }
+
+ if (aArguments.getCons() == null) {
+ throw new EvaluationException("Error in compiled code." + stackTrace, "none", -1);
+ } else {
//TODO FIXME ShowStack(aEnvironment);
- String error = showFunctionError(aArguments, aEnvironment) + "expected " + needed + " arguments, got " + passed;
- throw new EvaluationException(error,-1);
+ String error = showFunctionError(aArguments, aEnvironment) + "expected " + needed + " arguments, got " + passed + /*" in function " + functionName +*/ ". ";
+ throw new EvaluationException(error + stackTrace, "none", -1);
- /*TODO FIXME
- LispChar str[20];
- aEnvironment.iErrorOutput.Write("expected ");
- InternalIntToAscii(str,needed);
- aEnvironment.iErrorOutput.Write(str);
- aEnvironment.iErrorOutput.Write(" arguments, got ");
- InternalIntToAscii(str,passed);
- aEnvironment.iErrorOutput.Write(str);
- aEnvironment.iErrorOutput.Write("\n");
- LispError.check(passed == needed,LispError.WRONG_NUMBER_OF_ARGUMENTS);
- */
+ /*TODO FIXME
+ LispChar str[20];
+ aEnvironment.iErrorOutput.Write("expected ");
+ InternalIntToAscii(str,needed);
+ aEnvironment.iErrorOutput.Write(str);
+ aEnvironment.iErrorOutput.Write(" arguments, got ");
+ InternalIntToAscii(str,passed);
+ aEnvironment.iErrorOutput.Write(str);
+ aEnvironment.iErrorOutput.Write("\n");
+ LispError.check(passed == needed,LispError.WRONG_NUMBER_OF_ARGUMENTS);
+ */
}
}
- public static String showFunctionError(ConsPointer aArguments, Environment aEnvironment) throws Exception
- {
- if (aArguments.getCons() == null)
- {
+
+ public static String showFunctionError(ConsPointer aArguments, Environment aEnvironment) throws Exception {
+ if (aArguments.getCons() == null) {
return "Error in compiled code. ";
- } else
- {
+ } else {
String string = (String) aArguments.car();
- if (string != null)
- {
+ if (string != null) {
return "In function \"" + string + "\" : ";
}
}
return "[Atom]";
}
- public static void check(Environment aEnvironment, int aStackTop, boolean aPredicate, int errNo) throws Exception
- {
- if (!aPredicate)
- {
- ConsPointer arguments = BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 0);
- if (arguments.getCons() == null)
- {
- throw new EvaluationException("Error in compiled code\n",-1);
- } else
- {
- String error = "";
- //TODO FIXME ShowStack(aEnvironment);
- error = error + showFunctionError(arguments, aEnvironment) + "generic error.";
- throw new EvaluationException(error,-1);
+
+ public static void check(Environment aEnvironment, int aStackTop, boolean aPredicate, int errNo) throws Exception {
+ if (!aPredicate) {
+
+ String stackTrace = "";
+
+ if (Evaluator.isStackTraced() && aStackTop >= 0) {
+ stackTrace = aEnvironment.iArgumentStack.dump(aStackTop, aEnvironment);
+
+ stackTrace = stackTrace + aEnvironment.dumpLocalVariablesFrame(aStackTop);
+ }
+
+ if (aStackTop == -1) {
+ throw new EvaluationException("Error encountered during initialization: " + errorString(errNo) + stackTrace, "none", -1);
+ } else if (aStackTop == -2) {
+ throw new EvaluationException("Error: " + errorString(errNo) + stackTrace, "none", -1);
+ } else {
+ ConsPointer arguments = BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 0);
+ if (arguments.getCons() == null) {
+ throw new EvaluationException("Error in compiled code." + stackTrace, "none", -1);
+ } else {
+ String error = "";
+ error = error + showFunctionError(arguments, aEnvironment) + "internal.";
+ throw new EvaluationException(error + stackTrace, "none", -1);
+ }
}
}
}
- public static void lispAssert(boolean aPredicate) throws Exception
- {
- if (!aPredicate)
- {
- throw new EvaluationException("Assertion failed.",-1);
+
+ public static void lispAssert(boolean aPredicate, Environment aEnvironment, int aStackTop) throws Exception {
+ if (!aPredicate) {
+ //throw new EvaluationException("Assertion failed.","none",-1);
+ check(aPredicate, "Assertion error.", "", aStackTop, aEnvironment);
}
}
- public static void checkArgument(Environment aEnvironment, int aStackTop, boolean aPredicate, int aArgNr) throws Exception
- {
- checkArgumentTypeWithError(aEnvironment, aStackTop, aPredicate, aArgNr, "");
+
+ public static void checkArgument(Environment aEnvironment, int aStackTop, boolean aPredicate, int aArgNr, String functionName) throws Exception {
+ checkArgumentTypeWithError(aEnvironment, aStackTop, aPredicate, aArgNr, "", functionName);
}
- public static void checkIsList(Environment aEnvironment, int aStackTop, ConsPointer evaluated, int aArgNr) throws Exception
- {
- checkArgumentTypeWithError(aEnvironment, aStackTop, Utility.isSublist(evaluated), aArgNr, "argument is not a list.");
+
+ public static void checkIsList(Environment aEnvironment, int aStackTop, ConsPointer evaluated, int aArgNr, String functionName) throws Exception {
+ checkArgumentTypeWithError(aEnvironment, aStackTop, Utility.isSublist(evaluated), aArgNr, "argument is not a list.", functionName);
}
- public static void checkIsString(Environment aEnvironment, int aStackTop, ConsPointer evaluated, int aArgNr) throws Exception
- {
- checkArgumentTypeWithError(aEnvironment, aStackTop, Utility.isString( evaluated.car()), aArgNr, "argument is not a string.");
+
+ public static void checkIsString(Environment aEnvironment, int aStackTop, ConsPointer evaluated, int aArgNr, String functionName) throws Exception {
+ checkArgumentTypeWithError(aEnvironment, aStackTop, Utility.isString(evaluated.car()), aArgNr, "argument is not a string.", functionName);
}
- public static void checkArgumentTypeWithError(Environment aEnvironment, int aStackTop, boolean aPredicate, int aArgNr, String aErrorDescription) throws Exception
- {
- if (!aPredicate)
- {
+
+ public static void checkArgumentTypeWithError(Environment aEnvironment, int aStackTop, boolean aPredicate, int aArgNr, String aErrorDescription, String functionName) throws Exception {
+ if (!aPredicate) {
+ String stackTrace = "";
+
+ if (Evaluator.isStackTraced() && aStackTop >= 0) {
+ stackTrace = aEnvironment.iArgumentStack.dump(aStackTop, aEnvironment);
+
+ stackTrace = stackTrace + aEnvironment.dumpLocalVariablesFrame(aStackTop);
+ }
+
ConsPointer arguments = BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 0);
- if (arguments.getCons() == null)
- {
- throw new EvaluationException("Error in compiled code\n",-1);
- } else
- {
+ if (arguments.getCons() == null) {
+ throw new EvaluationException("Error in compiled code." + stackTrace, "none", -1);
+ } else {
String error = "";
- //TODO FIXME ShowStack(aEnvironment);
error = error + showFunctionError(arguments, aEnvironment) + "\nbad argument number " + aArgNr + "(counting from 1) : \n" + aErrorDescription + "\n";
- ConsPointer arg = BuiltinFunction.getArgumentPointer(arguments, aArgNr);
+ ConsPointer arg = BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, arguments, aArgNr);
String strout;
error = error + "The offending argument ";
- strout = Utility.printExpression(arg, aEnvironment, 60);
+ strout = Utility.printMathPiperExpression(aStackTop, arg, aEnvironment, 60);
error = error + strout;
ConsPointer eval = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, eval, arg);
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, eval, arg);
error = error + " evaluated to ";
- strout = Utility.printExpression(eval, aEnvironment, 60);
+ strout = Utility.printMathPiperExpression(aStackTop, eval, aEnvironment, 60);
error = error + strout;
error = error + "\n";
- throw new EvaluationException(error,-1);
+ throw new EvaluationException(error + stackTrace, "none", -1);
}//end else.
}
}
-}
\ No newline at end of file
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/LispExpressionEvaluator.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/LispExpressionEvaluator.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/LispExpressionEvaluator.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/LispExpressionEvaluator.java 2011-02-05 04:04:44.000000000 +0000
@@ -13,22 +13,15 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp;
-import org.mathpiper.lisp.*;
-import org.mathpiper.lisp.DefFile;
import org.mathpiper.lisp.cons.ConsPointer;
import org.mathpiper.lisp.cons.Cons;
-import org.mathpiper.io.MathPiperOutputStream;
-import org.mathpiper.io.StringOutputStream;
import org.mathpiper.builtin.BuiltinFunctionEvaluator;
-import org.mathpiper.lisp.userfunctions.MultipleArityUserFunction;
+import org.mathpiper.lisp.rulebases.MultipleArityRulebase;
-import org.mathpiper.lisp.userfunctions.SingleArityBranchingUserFunction;
-import org.mathpiper.lisp.printers.MathPiperPrinter;
-import org.mathpiper.lisp.Evaluator;
+import org.mathpiper.lisp.rulebases.SingleArityRulebase;
/**
* The basic evaluator for Lisp expressions.
@@ -52,11 +45,11 @@
*
*
* If aExpression is a list, the head of the list is
- * examined. If the head is not a string. InternalApplyPure()
+ * examined. If the head is not a string. ApplyFast()
* is called. If the head is a string, it is checked against
* the core commands (if there is a check, the corresponding
* evaluator is called). Then it is checked agaist the list of
- * user function with getUserFunction(). Again, the
+ * user function with getRulebase(). Again, the
* corresponding evaluator is called if there is a check. If
* all fails, ReturnUnEvaluated() is called.
*
@@ -73,97 +66,127 @@
* @param aExpression the expression to evaluate
* @throws java.lang.Exception
*/
- public void evaluate(Environment aEnvironment, ConsPointer aResult, ConsPointer aExpression) throws Exception {
- LispError.lispAssert(aExpression.getCons() != null);
+ public void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aExpression) throws Exception {
+
+ LispError.lispAssert(aExpression.getCons() != null, aEnvironment, aStackTop);
synchronized (aEnvironment) {
aEnvironment.iEvalDepth++;
if (aEnvironment.iEvalDepth >= aEnvironment.iMaxEvalDepth) {
- if (aEnvironment.iEvalDepth > aEnvironment.iMaxEvalDepth + 20) {
- LispError.check(aEnvironment.iEvalDepth < aEnvironment.iMaxEvalDepth, LispError.USER_INTERRUPT);
- } else {
- LispError.check(aEnvironment.iEvalDepth < aEnvironment.iMaxEvalDepth, LispError.MAXIMUM_RECURSE_DEPTH_REACHED);
- }
+ /* if (aEnvironment.iEvalDepth > aEnvironment.iMaxEvalDepth + 20) {
+ LispError.check(aEnvironment, aStackTop, aEnvironment.iEvalDepth < aEnvironment.iMaxEvalDepth, LispError.USER_INTERRUPT, "INTERNAL");
+ } else {*/
+ LispError.check(aEnvironment, aStackTop, aEnvironment.iEvalDepth < aEnvironment.iMaxEvalDepth, LispError.MAXIMUM_RECURSE_DEPTH_REACHED, "INTERNAL");
+ // }
+ }
+
+ if (Thread.interrupted()) {
+ LispError.raiseError("User halted calculation.", "", aStackTop, aEnvironment);
}
}
// evaluate an atom: find the bound value (treat it as a variable)
- if ( aExpression.car() instanceof String) {
+ if (aExpression.car() instanceof String) {
String str = (String) aExpression.car();
if (str.charAt(0) == '\"') {
- aResult.setCons(aExpression.getCons().copy( aEnvironment, false));
+ aResult.setCons(aExpression.getCons().copy(aEnvironment, false));
aEnvironment.iEvalDepth--;
return;
}
ConsPointer val = new ConsPointer();
- aEnvironment.getGlobalVariable(str, val);
+ aEnvironment.getGlobalVariable(aStackTop, str, val);
if (val.getCons() != null) {
- aResult.setCons(val.getCons().copy( aEnvironment, false));
+ aResult.setCons(val.getCons().copy(aEnvironment, false));
aEnvironment.iEvalDepth--;
return;
}
- aResult.setCons(aExpression.getCons().copy( aEnvironment, false));
+ aResult.setCons(aExpression.getCons().copy(aEnvironment, false));
aEnvironment.iEvalDepth--;
return;
}
{
- if ( aExpression.car() instanceof ConsPointer) {
+ if (aExpression.car() instanceof ConsPointer) {
ConsPointer subList = (ConsPointer) aExpression.car();
Cons head = subList.getCons();
if (head != null) {
+
+ String functionName;
+
if (head.car() instanceof String) {
- {
- BuiltinFunctionEvaluator evaluator = (BuiltinFunctionEvaluator) aEnvironment.getBuiltinFunctions().lookUp( (String) head.car());
- // Try to find a built-in command
- if (evaluator != null) {
- evaluator.evaluate(aEnvironment, aResult, subList);
- aEnvironment.iEvalDepth--;
- return;
- }
+
+ functionName = (String) head.car();
+
+ //Built-in function handler.
+ BuiltinFunctionEvaluator builtinInFunctionEvaluator = (BuiltinFunctionEvaluator) aEnvironment.getBuiltinFunctions().lookUp(functionName);
+ if (builtinInFunctionEvaluator != null) {
+ builtinInFunctionEvaluator.evaluate(aEnvironment, aStackTop, aResult, subList);
+ aEnvironment.iEvalDepth--;
+ return;
}
- {
- SingleArityBranchingUserFunction userFunc;
- userFunc = getUserFunction(aEnvironment, subList);
- if (userFunc != null) {
- userFunc.evaluate(aEnvironment, aResult, subList);
- aEnvironment.iEvalDepth--;
- return;
- }
+
+ //User function handler.
+ SingleArityRulebase userFunction;
+ userFunction = getUserFunction(aEnvironment, aStackTop, subList);
+ if (userFunction != null) {
+ userFunction.evaluate(aEnvironment, aStackTop, aResult, subList);
+ aEnvironment.iEvalDepth--;
+ return;
}
+
+
} else {
- //printf("ApplyPure!\n");
- ConsPointer oper = new ConsPointer();
+ //Pure function handler.
+ ConsPointer operator = new ConsPointer();
ConsPointer args2 = new ConsPointer();
- oper.setCons(subList.getCons());
+ operator.setCons(subList.getCons());
args2.setCons(subList.cdr().getCons());
- Utility.applyPure(oper, args2, aResult, aEnvironment);
+ Utility.applyPure(aStackTop, operator, args2, aResult, aEnvironment);
aEnvironment.iEvalDepth--;
return;
}
//printf("**** Undef: %s\n",head.String().String());
- Utility.returnUnEvaluated(aResult, subList, aEnvironment);
+
+
+ /* todo:tk: This code is for experimenting with having non-existent functions throw an exception when they are called.
+ if (functionName.equals("_")) {
+ Utility.returnUnEvaluated(aStackTop, aResult, subList, aEnvironment);
+ aEnvironment.iEvalDepth--;
+ return;
+ } else {
+ LispError.raiseError("The function " + functionName + " is not defined.\n", null, aStackTop, aEnvironment );
+ }*/
+
+
+ Utility.returnUnEvaluated(aStackTop, aResult, subList, aEnvironment);
+
aEnvironment.iEvalDepth--;
+
return;
+
+
+
+
}
}
- aResult.setCons(aExpression.getCons().copy( aEnvironment, false));
+ aResult.setCons(aExpression.getCons().copy(aEnvironment, false));
}
aEnvironment.iEvalDepth--;
}
- SingleArityBranchingUserFunction getUserFunction(Environment aEnvironment, ConsPointer subList) throws Exception {
+
+ SingleArityRulebase getUserFunction(Environment aEnvironment, int aStackTop, ConsPointer subList) throws Exception {
Cons head = subList.getCons();
- SingleArityBranchingUserFunction userFunc = null;
+ SingleArityRulebase userFunc = null;
- userFunc = (SingleArityBranchingUserFunction) aEnvironment.getUserFunction(subList);
+ userFunc = (SingleArityRulebase) aEnvironment.getRulebase(aStackTop, subList);
if (userFunc != null) {
return userFunc;
} else if (head.car() instanceof String) {
- MultipleArityUserFunction multiUserFunc = aEnvironment.getMultipleArityUserFunction( (String) head.car(), true);
+ MultipleArityRulebase multiUserFunc = aEnvironment.getMultipleArityRulebase(aStackTop, (String) head.car(), true);
if (multiUserFunc.iFileToOpen != null) {
DefFile def = multiUserFunc.iFileToOpen;
@@ -191,7 +214,7 @@
multiUserFunc.iFileToOpen = null;
- Utility.use(aEnvironment, def.iFileName);
+ Utility.loadScriptOnce(aEnvironment, aStackTop, def.iFileName);
if (DEBUG) {
//extern int VERBOSE_DEBUG;
@@ -213,7 +236,7 @@
}
}
}
- userFunc = aEnvironment.getUserFunction(subList);
+ userFunc = aEnvironment.getRulebase(aStackTop, subList);
}
return userFunc;
}//end method.
@@ -438,9 +461,11 @@
{
LispLocalEvaluator local(aEnvironment,NEW BasicEvaluator);
LispPtr result;
- defaultEval.Eval(aEnvironment, result, iError);
+ defaultEval.Eval(aEnvironment, result, iException);
}
*/
-}//end class.
\ No newline at end of file
+
+}//end class.
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/localvariables/LocalVariableFrame.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/localvariables/LocalVariableFrame.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/localvariables/LocalVariableFrame.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/localvariables/LocalVariableFrame.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,47 +13,44 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.localvariables;
- public class LocalVariableFrame
- {
- public LocalVariableFrame iNext;
- public LocalVariable iFirst;
- LocalVariable iLast;
- private String functionName;
-
- public LocalVariableFrame(LocalVariableFrame aNext, LocalVariable aFirst, String functionName)
- {
- iNext = aNext;
- iFirst = aFirst;
- iLast = aFirst;
- this.functionName = functionName;
- }
+public class LocalVariableFrame {
+
+ public LocalVariableFrame iNext;
+ public LocalVariable iFirst;
+ LocalVariable iLast;
+ private String functionName;
+
+
+ public LocalVariableFrame(LocalVariableFrame aNext, LocalVariable aFirst, String functionName) {
+ iNext = aNext;
+ iFirst = aFirst;
+ iLast = aFirst;
+ this.functionName = functionName;
+ }
+
+
+ public void add(LocalVariable aNew) {
+ aNew.iNext = iFirst;
+ iFirst = aNew;
+ }
+
- public void add(LocalVariable aNew)
- {
- aNew.iNext = iFirst;
- iFirst = aNew;
+ public void delete() {
+ LocalVariable t = iFirst;
+ LocalVariable next;
+ while (t != iLast) {
+ next = t.iNext;
+ t = next;
}
+ }//end method.
- public void delete()
- {
- LocalVariable t = iFirst;
- LocalVariable next;
- while (t != iLast)
- {
- next = t.iNext;
- t = next;
- }
- }//end method.
public String getFunctionName() {
return functionName;
}
-
+}//end class
- }//end class
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/localvariables/LocalVariable.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/localvariables/LocalVariable.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/localvariables/LocalVariable.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/localvariables/LocalVariable.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,27 +13,27 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.localvariables;
+import org.mathpiper.lisp.Environment;
import org.mathpiper.lisp.cons.Cons;
import org.mathpiper.lisp.cons.ConsPointer;
- public class LocalVariable
- {
+public class LocalVariable {
+
+ public LocalVariable iNext;
+ public String iVariable;
+ public ConsPointer iValue;
- public LocalVariable iNext;
- public String iVariable;
- public ConsPointer iValue = new ConsPointer();
-
- public LocalVariable(String aVariable, Cons aValue)
- {
- iNext = null;
- iVariable = aVariable;
- iValue.setCons(aValue);
- }
+ public LocalVariable(Environment aEnvironment, String aVariable, Cons aValue) {
+ iNext = null;
+ iVariable = aVariable;
+ iValue = new ConsPointer();
+ iValue.setCons(aValue);
+
}
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Operator.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Operator.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Operator.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Operator.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,49 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp;
+
+public class Operator {
+
+ public int iPrecedence;
+ public int iLeftPrecedence;
+ public int iRightPrecedence;
+ public int iRightAssociative;
+
+
+ public Operator(int aPrecedence) {
+ iPrecedence = aPrecedence;
+ iLeftPrecedence = aPrecedence;
+ iRightPrecedence = aPrecedence;
+ iRightAssociative = 0;
+ }
+
+
+ public void setRightAssociative() {
+ iRightAssociative = 1;
+ }
+
+
+ public void setLeftPrecedence(int aPrecedence) {
+ iLeftPrecedence = aPrecedence;
+ }
+
+
+ public void setRightPrecedence(int aPrecedence) {
+ iRightPrecedence = aPrecedence;
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Atom.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Atom.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Atom.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Atom.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.parametermatchers;
-
-import org.mathpiper.builtin.BigNumber;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
-import org.mathpiper.lisp.cons.NumberCons;
-
-
-/// Class for matching an expression to a given atom.
-public class Atom extends PatternParameter
-{
- protected String iString;
-
- public Atom(String aString)
- {
- iString = aString;
- }
-
- public boolean argumentMatches(Environment aEnvironment,
- ConsPointer aExpression,
- ConsPointer[] arguments) throws Exception
- {
- // If it is a floating point, don't even bother comparing
- if (aExpression.getCons() != null)
- if (aExpression.getCons().getNumber(aEnvironment.getPrecision()) != null)
- if (! ((BigNumber) ((NumberCons) aExpression.getCons()).getNumber(aEnvironment.getPrecision())).isInteger())
- return false;
-
- return (iString == aExpression.car());
- }
-
- public String getType()
- {
- return "Atom";
- }
-
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/AtomPatternParameterMatcher.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/AtomPatternParameterMatcher.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/AtomPatternParameterMatcher.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/AtomPatternParameterMatcher.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,64 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.parametermatchers;
+
+import org.mathpiper.builtin.BigNumber;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.NumberCons;
+
+//Class for matching an expression to a given atom.
+public class AtomPatternParameterMatcher extends PatternParameterMatcher {
+
+ protected String iString;
+
+
+ public AtomPatternParameterMatcher(String aString) {
+ iString = aString;
+ }
+
+
+ public boolean argumentMatches(Environment aEnvironment, int aStackTop, ConsPointer aExpression, ConsPointer[] arguments) throws Exception {
+
+ // If it is a floating point, don't even bother comparing
+ if (aExpression.getCons() != null) {
+ try {
+ if (aExpression.getCons().getNumber(aEnvironment.getPrecision(), aEnvironment) != null) {
+ if (!((BigNumber) ((NumberCons) aExpression.getCons()).getNumber(aEnvironment.getPrecision(), aEnvironment)).isInteger()) {
+ return false;
+ }
+ }
+ } catch (NumberFormatException e) {
+ return false;
+ }
+ }
+
+ return (iString == aExpression.car());
+ }
+
+
+ public String getType() {
+ return "Atom";
+ }
+
+ @Override
+ public String toString()
+ {
+ return iString;
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Number.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Number.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Number.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Number.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.parametermatchers;
-
-import org.mathpiper.builtin.BigNumber;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
-import org.mathpiper.lisp.LispError;
-
-
-/// Class for matching an expression to a given number.
-public class Number extends PatternParameter
-{
- protected BigNumber iNumber;
-
- public Number(BigNumber aNumber)
- {
- iNumber = aNumber;
- }
-
- public boolean argumentMatches(Environment aEnvironment,
- ConsPointer aExpression,
- ConsPointer[] arguments) throws Exception
- {
-// LispError.check(aExpression.type().equals("Number"), LispError.KLispErrInvalidArg);
- BigNumber bigNumber = (BigNumber) aExpression.getCons().getNumber(aEnvironment.getPrecision());
- if (bigNumber != null)
- return iNumber.equals(bigNumber);
- return false;
- }
-
- public String getType()
- {
- return "Number";
- }
-
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/NumberPatternParameterMatcher.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/NumberPatternParameterMatcher.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/NumberPatternParameterMatcher.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/NumberPatternParameterMatcher.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,58 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.parametermatchers;
+
+import org.mathpiper.builtin.BigNumber;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+
+/// Class for matching an expression to a given number.
+public class NumberPatternParameterMatcher extends PatternParameterMatcher {
+
+ protected BigNumber iNumber;
+
+
+ public NumberPatternParameterMatcher(BigNumber aNumber) {
+ iNumber = aNumber;
+ }
+
+
+ public boolean argumentMatches(Environment aEnvironment, int aStackTop, ConsPointer aExpression, ConsPointer[] arguments) throws Exception {
+
+ BigNumber bigNumber = (BigNumber) aExpression.getCons().getNumber(aEnvironment.getPrecision(), aEnvironment);
+
+ if (bigNumber != null) {
+ return iNumber.equals(bigNumber);
+ }
+
+ return false;
+ }
+
+
+ public String getType() {
+ return "Number";
+ }
+
+
+ @Override
+ public String toString()
+ {
+ return this.iNumber.toString();
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/ParametersPatternMatcher.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/ParametersPatternMatcher.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/ParametersPatternMatcher.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/ParametersPatternMatcher.java 2010-07-19 00:43:47.000000000 +0000
@@ -0,0 +1,404 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.parametermatchers;
+
+import org.mathpiper.lisp.cons.Cons;
+import org.mathpiper.lisp.Utility;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.cons.ConsTraverser;
+//import org.mathpiper.lisp.AtomCons;
+import org.mathpiper.lisp.Environment;
+//import org.mathpiper.lisp.SublistCons;
+import java.util.*;
+import org.mathpiper.builtin.BigNumber;
+
+/**
+ *ParametersPatternMatcher matching code.
+ *
+ *General idea: have a class that can match function parameters
+ *to a pattern, check for predicates on the arguments, and return
+ *whether there was a match.
+ *
+ *First the pattern is mapped onto the arguments. Then local variables
+ *are set. Then the predicates are called. If they all return true,
+ *Then the pattern matches, and the locals can stay (the body is expected
+ *to use these variables).
+ *
+ *Class that matches function arguments to a pattern.
+ *This class (specifically, the matches() member function) can match
+ *function parameters to a pattern, check for predicates on the
+ *arguments, and return whether there was a match.
+ */
+public class ParametersPatternMatcher {
+ //List of parameter matchers, one for every parameter.
+ protected List iParamMatchers = new ArrayList();
+
+ // List of variables appearing in the pattern.
+ protected List iVariables = new ArrayList();
+
+ // List of predicates which need to be true for a match.
+ protected List iPredicates = new ArrayList();
+
+
+ /**
+ *Constructor.
+ *@param aEnvironment the underlying Lisp environment
+ *@param aPattern Lisp expression containing the pattern
+ *@param aPostPredicate Lisp expression containing the postpredicate
+ *
+ *The function makeParameterMatcher() is called for every argument
+ *in aPattern, and the resulting pattern matchers are
+ *collected in iParamMatchers. Additionally, aPostPredicate
+ *is copied, and the copy is added to iPredicates.
+ */
+ public ParametersPatternMatcher(Environment aEnvironment, int aStackTop, ConsPointer aPattern, ConsPointer aPostPredicate) throws Exception {
+
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, aPattern);
+
+ while (consTraverser.getCons() != null) {
+
+ PatternParameterMatcher matcher = makeParameterMatcher(aEnvironment, aStackTop, consTraverser.getCons());
+
+ LispError.lispAssert(matcher != null, aEnvironment, aStackTop);
+
+ iParamMatchers.add(matcher);
+
+ consTraverser.goNext(aStackTop);
+ }//end while.
+
+ ConsPointer postPredicatesPointer = new ConsPointer();
+
+ postPredicatesPointer.setCons(aPostPredicate.getCons());
+
+ iPredicates.add(postPredicatesPointer);
+
+
+ }//end method.
+
+
+ /*
+ Try to match the pattern against aArguments.
+ First, every argument in aArguments is matched against the
+ corresponding PatternParameterMatcher in iParamMatches. If any
+ match fails, matches() returns false. Otherwise, a temporary
+ LispLocalFrame is constructed, then setPatternVariables() and
+ checkPredicates() are called, and then the LispLocalFrame is
+ immediately deleted. If checkPredicates() returns false, this
+ function also returns false. Otherwise, setPatternVariables()
+ is called again, but now in the current LispLocalFrame, and
+ this function returns true.
+ */
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer aArguments) throws Exception {
+ int i;
+
+ ConsPointer[] argumentsPointer = null;
+ if (iVariables.size() > 0) {
+ argumentsPointer = new ConsPointer[iVariables.size()];
+ for (i = 0; i < iVariables.size(); i++) {
+ argumentsPointer[i] = new ConsPointer();
+ }
+
+ }
+ ConsTraverser argumentsTraverser = new ConsTraverser(aEnvironment, aArguments);
+
+ for (i = 0; i < iParamMatchers.size(); i++) {
+ if (argumentsTraverser.getCons() == null) {
+ return false;
+ }
+ ConsPointer argumentsPointer2 = argumentsTraverser.getPointer();
+ if (argumentsPointer2 == null) {
+ return false;
+ }
+ if (!((PatternParameterMatcher) iParamMatchers.get(i)).argumentMatches(aEnvironment, aStackTop, argumentsPointer2, argumentsPointer)) {
+ return false;
+ }
+ argumentsTraverser.goNext(aStackTop);
+ }
+ if (argumentsTraverser.getCons() != null) {
+ return false;
+ }
+
+ {
+ //Set the local variables.
+ aEnvironment.pushLocalFrame(false, "Pattern");
+ try {
+ setPatternVariables(aEnvironment, argumentsPointer, aStackTop);
+
+ //Do the predicates
+ if (!checkPredicates(aEnvironment, aStackTop)) {
+ return false;
+ }
+ } catch (Exception e) {
+ throw e;
+ } finally {
+ aEnvironment.popLocalFrame(aStackTop);
+ }
+ }
+
+ // setCons the local variables for sure now
+ setPatternVariables(aEnvironment, argumentsPointer, aStackTop);
+
+ return true;
+ }
+
+
+ /**
+ *Try to match the pattern against aArguments.
+ *This function does the same as matches(Environment, ConsPointer),
+ *but differs in the type of the arguments.
+ */
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception {
+ int i;
+
+ ConsPointer[] arguments = null;
+ if (iVariables.size() > 0) {
+ arguments = new ConsPointer[iVariables.size()];
+ }
+ for (i = 0; i < iVariables.size(); i++) {
+ arguments[i] = new ConsPointer();
+ }
+
+
+
+ for (i = 0; i < iParamMatchers.size(); i++) {
+ LispError.check(i < aArguments.length, "Listed function definitions need at least two parameters.", "INTERNAL", aStackTop, aEnvironment);
+ PatternParameterMatcher patternParameter = (PatternParameterMatcher) iParamMatchers.get(i);
+ ConsPointer argument = aArguments[i];
+ if (!patternParameter.argumentMatches(aEnvironment, aStackTop, argument, arguments)) {
+ return false;
+ }
+ }
+
+ {
+ //Set the local variables.
+ aEnvironment.pushLocalFrame(false, "Pattern");
+ try {
+ setPatternVariables(aEnvironment, arguments, aStackTop);
+
+ //Check the predicates.
+ if (!checkPredicates(aEnvironment, aStackTop)) {
+ return false;
+ }
+ } catch (Exception e) {
+ throw e;
+ } finally {
+ aEnvironment.popLocalFrame(aStackTop);
+ }
+ }
+
+ // Set the local variables for sure now.
+ setPatternVariables(aEnvironment, arguments, aStackTop);
+
+ return true;
+ }
+
+
+ /*
+ Construct a pattern matcher out of a Lisp expression.
+ The result of this function depends on the value of aPattern:
+ - If aPattern is a number, the corresponding NumberPatternParameterMatcher is
+ constructed and returned.
+ - If aPattern is an atom, the corresponding AtomCons is
+ constructed and returned.
+ - If aPattern is a list of the form ( _var ),
+ where var is an atom, lookUp() is called on var. Then
+ the correspoding VariablePatternParameterMatcher is constructed and returned.
+ - If aPattern is a list of the form ( var_expr ),
+ where var is an atom, lookUp() is called on var. Then,
+ expr is appended to #iPredicates. Finally, the
+ correspoding VariablePatternParameterMatcher is constructed and returned.
+ - If aPattern is a list of another form, this function
+ calls itself on any of the entries in this list. The
+ resulting PatternParameterMatcher objects are collected in a
+ SublistCons, which is returned.
+ - Otherwise, this function returns #null.
+ */
+ protected PatternParameterMatcher makeParameterMatcher(Environment aEnvironment, int aStackTop, Cons aPattern) throws Exception {
+
+ if (aPattern == null) {
+ return null;
+ }
+
+
+ //Check for a number pattern.
+ if (aPattern.getNumber(aEnvironment.getPrecision(), aEnvironment) != null) {
+ return new NumberPatternParameterMatcher((BigNumber) aPattern.getNumber(aEnvironment.getPrecision(), aEnvironment));
+ }
+
+
+ //Check for an atom pattern.
+ if (aPattern.car() instanceof String) {
+ return new AtomPatternParameterMatcher((String) aPattern.car());
+ }
+
+
+ // Else, it must be a sublist pattern.
+ if (aPattern.car() instanceof ConsPointer) {
+
+ // See if it is a variable template:
+ ConsPointer sublist = (ConsPointer) aPattern.car();
+ //LispError.lispAssert(sublist != null);
+
+ int num = Utility.listLength(aEnvironment, aStackTop, sublist);
+
+ // variable matcher here...
+ if (num > 1) {
+ Cons head = sublist.getCons();
+
+ //Handle _ prefix or suffix on a pattern variables.
+ if (((String) head.car()) == aEnvironment.getTokenHash().lookUp("_")) {
+ Cons second = head.cdr().getCons();
+ if (second.car() instanceof String) {
+ int index = lookUp((String) second.car());
+
+
+ if (num > 2) {
+ //Handle a pattern variable which has a predicate (like var_PredicateFunction).
+ ConsPointer third = new ConsPointer();
+
+ Cons predicate = second.cdr().getCons();
+ if ((predicate.car() instanceof ConsPointer)) {
+ Utility.flatCopy(aEnvironment, aStackTop, third, (ConsPointer) predicate.car());
+ } else {
+ third.setCons(second.cdr().getCons().copy(aEnvironment, false));
+ }
+
+ String str = (String) second.car();
+ Cons last = third.getCons();
+ while (last.cdr().getCons() != null) {
+ last = last.cdr().getCons();
+ }
+
+ last.cdr().setCons(org.mathpiper.lisp.cons.AtomCons.getInstance(aEnvironment, aStackTop, str));
+
+ ConsPointer newPredicate = new ConsPointer();
+ newPredicate.setCons(org.mathpiper.lisp.cons.SublistCons.getInstance(aEnvironment, third.getCons()));
+
+ iPredicates.add(newPredicate);
+ }//end if.
+
+ return new VariablePatternParameterMatcher(index);
+ }
+ }
+ }
+
+ PatternParameterMatcher[] matchers = new PatternParameterMatcher[num];
+
+ int i;
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, sublist);
+ for (i = 0; i < num; i++) {
+ matchers[i] = makeParameterMatcher(aEnvironment, aStackTop, consTraverser.getCons());
+ LispError.lispAssert(matchers[i] != null, aEnvironment, aStackTop);
+ consTraverser.goNext(aStackTop);
+ }
+ return new SublistPatternParameterMatcher(matchers, num);
+ }
+
+ return null;
+
+ }//end method.
+
+
+ /*
+ *Look up a variable name in iVariables.
+ *Returns index in iVariables array where aVariable
+ *appears. If aVariable is not in iVariables, it is added.
+ */
+ protected int lookUp(String aVariable) {
+ int i;
+ for (i = 0; i < iVariables.size(); i++) {
+ if (iVariables.get(i) == aVariable) {
+ return i;
+ }
+ }
+ iVariables.add(aVariable);
+ return iVariables.size() - 1;
+ }
+
+
+ /**
+ *Set local variables corresponding to the pattern variables.
+ *This function goes through the #iVariables array. A local
+ *variable is made for every entry in the array, and the
+ *corresponding argument is assigned to it.
+ */
+ protected void setPatternVariables(Environment aEnvironment, ConsPointer[] arguments, int aStackTop) throws Exception {
+ int i;
+ for (i = 0; i < iVariables.size(); i++) {
+ //Set the variable to the new value
+ aEnvironment.newLocalVariable((String) iVariables.get(i), arguments[i].getCons(), aStackTop);
+ }
+ }
+
+
+ /**
+ *Check whether all predicates are true.
+ *This function goes through all predicates in iPredicates and
+ *evaluates them. It returns false if at least one
+ *of these results IsFalse(). An error is raised if any result
+ *that is neither IsTrue() nor IsFalse().
+ */
+ protected boolean checkPredicates(Environment aEnvironment, int aStackTop) throws Exception {
+ int i;
+ for (i = 0; i < iPredicates.size(); i++) {
+
+ ConsPointer resultPredicate = new ConsPointer();
+
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, resultPredicate, ((ConsPointer) iPredicates.get(i)));
+
+ if (Utility.isFalse(aEnvironment, resultPredicate, aStackTop)) {
+ return false;
+ }
+
+
+ // If the result is not False, it should be True, else probably something is wrong (the expression returned unevaluated)
+ boolean isTrue = Utility.isTrue(aEnvironment, resultPredicate, aStackTop);
+ if (!isTrue) {
+ //TODO this is probably not the right way to generate an error, should we perhaps do a full throw new MathPiperException here?
+ String strout;
+ aEnvironment.write("The predicate\n\t");
+ strout = Utility.printMathPiperExpression(aStackTop, ((ConsPointer) iPredicates.get(i)), aEnvironment, 60);
+ aEnvironment.write(strout);
+ aEnvironment.write("\nevaluated to\n\t");
+ strout = Utility.printMathPiperExpression(aStackTop, resultPredicate, aEnvironment, 60);
+ aEnvironment.write(strout);
+ aEnvironment.write("\n");
+
+ LispError.check(aEnvironment, aStackTop, isTrue, LispError.NON_BOOLEAN_PREDICATE_IN_PATTERN, "INTERNAL");
+ }
+ }
+ return true;
+ }
+
+
+ public List getParameterMatchers() {
+ return iParamMatchers;
+ }
+
+
+ public List getPredicates() {
+ return iPredicates;
+ }
+
+
+ public List getVariables() {
+ return iVariables;
+ }
+
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Pattern.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Pattern.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Pattern.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Pattern.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,360 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.parametermatchers;
-
-import org.mathpiper.lisp.cons.Cons;
-import org.mathpiper.lisp.Utility;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.cons.ConsTraverser;
-//import org.mathpiper.lisp.AtomCons;
-import org.mathpiper.lisp.Environment;
-//import org.mathpiper.lisp.SublistCons;
-import java.util.*;
-import org.mathpiper.builtin.BigNumber;
-
-/**
- *Pattern matching code.
- *
- *General idea: have a class that can match function parameters
- *to a pattern, check for predicates on the arguments, and return
- *whether there was a match.
- *
- *First the pattern is mapped onto the arguments. Then local variables
- *are set. Then the predicates are called. If they all return true,
- *Then the pattern matches, and the locals can stay (the body is expected
- *to use these variables).
- *
- *Class that matches function arguments to a pattern.
- *This class (specifically, the matches() member function) can match
- *function parameters to a pattern, check for predicates on the
- *arguments, and return whether there was a match.
- */
-public class Pattern {
- /// List of parameter matches, one for every parameter.
- protected List iParamMatchers = new ArrayList(); //CDeletingArrayGrower iParamMatchers;
-
- /// List of variables appearing in the pattern.
- protected List iVariables = new ArrayList(); //CArrayGrower
-
- /// List of predicates which need to be true for a match.
- protected List iPredicates = new ArrayList(); //CDeletingArrayGrower
-
- /// Constructor.
- /// \param aEnvironment the underlying Lisp environment
- /// \param aPattern Lisp expression containing the pattern
- /// \param aPostPredicate Lisp expression containing the
- /// postpredicate
- ///
- /// The function MakePatternMatcher() is called for every argument
- /// in \a aPattern, and the resulting pattern matchers are
- /// collected in #iParamMatchers. Additionally, \a aPostPredicate
- /// is copied, and the copy is added to #iPredicates.
- public Pattern(Environment aEnvironment,
- ConsPointer aPattern,
- ConsPointer aPostPredicate) throws Exception {
- ConsTraverser consTraverser = new ConsTraverser(aPattern);
-
- while (consTraverser.getCons() != null) {
- PatternParameter matcher = makeParamMatcher(aEnvironment, consTraverser.getCons());
- LispError.lispAssert(matcher != null);
- iParamMatchers.add(matcher);
- consTraverser.goNext();
- }
- ConsPointer post = new ConsPointer();
- post.setCons(aPostPredicate.getCons());
- iPredicates.add(post);
- }
-
-
- /// Try to match the pattern against \a aArguments.
- /// First, every argument in \a aArguments is matched against the
- /// corresponding PatternParameter in #iParamMatches. If any
- /// match fails, matches() returns false. Otherwise, a temporary
- /// LispLocalFrame is constructed, then setPatternVariables() and
- /// checkPredicates() are called, and then the LispLocalFrame is
- /// immediately deleted. If checkPredicates() returns false, this
- /// function also returns false. Otherwise, setPatternVariables()
- /// is called again, but now in the current LispLocalFrame, and
- /// this function returns true.
- public boolean matches(Environment aEnvironment, ConsPointer aArguments) throws Exception {
- int i;
-
- ConsPointer[] argumentsPointer = null;
- if (iVariables.size() > 0) {
- argumentsPointer = new ConsPointer[iVariables.size()];
- for (i = 0; i < iVariables.size(); i++) {
- argumentsPointer[i] = new ConsPointer();
- }
-
- }
- ConsTraverser argumentsTraverser = new ConsTraverser(aArguments);
-
- for (i = 0; i < iParamMatchers.size(); i++) {
- if (argumentsTraverser.getCons() == null) {
- return false;
- }
- ConsPointer argumentsPointer2 = argumentsTraverser.getPointer();
- if (argumentsPointer2 == null) {
- return false;
- }
- if (!((PatternParameter) iParamMatchers.get(i)).argumentMatches(aEnvironment, argumentsPointer2, argumentsPointer)) {
- return false;
- }
- argumentsTraverser.goNext();
- }
- if (argumentsTraverser.getCons() != null) {
- return false;
- }
-
- {
- // setCons the local variables.
- aEnvironment.pushLocalFrame(false, "Pattern");
- try {
- setPatternVariables(aEnvironment, argumentsPointer);
-
- // do the predicates
- if (!checkPredicates(aEnvironment)) {
- return false;
- }
- } catch (Exception e) {
- throw e;
- } finally {
- aEnvironment.popLocalFrame();
- }
- }
-
- // setCons the local variables for sure now
- setPatternVariables(aEnvironment, argumentsPointer);
-
- return true;
- }
-
- /// Try to match the pattern against \a aArguments.
- /// This function does the same as matches(Environment ,ConsPointer ),
- /// but differs in the type of the arguments.
- public boolean matches(Environment aEnvironment, ConsPointer[] aArguments) throws Exception {
- int i;
-
- ConsPointer[] arguments = null;
- if (iVariables.size() > 0) {
- arguments = new ConsPointer[iVariables.size()];
- }
- for (i = 0; i < iVariables.size(); i++) {
- arguments[i] = new ConsPointer();
- }
-
-
-
- for (i = 0; i < iParamMatchers.size(); i++) {
- LispError.check(i < aArguments.length, "Listed function definitions need at least two parameters.");
- PatternParameter patternParameter = (PatternParameter) iParamMatchers.get(i);
- ConsPointer argument = aArguments[i];
- if (! patternParameter.argumentMatches(aEnvironment, argument, arguments)) {
- return false;
- }
- }
-
- {
- // setCons the local variables.
- aEnvironment.pushLocalFrame(false, "Pattern");
- try {
- setPatternVariables(aEnvironment, arguments);
-
- // do the predicates
- if (!checkPredicates(aEnvironment)) {
- return false;
- }
- } catch (Exception e) {
- throw e;
- } finally {
- aEnvironment.popLocalFrame();
- }
- }
-
- // setCons the local variables for sure now
- setPatternVariables(aEnvironment, arguments);
- return true;
- }
-
- /// Construct a pattern matcher out of a Lisp expression.
- /// The result of this function depends on the value of \a aPattern:
- /// - If \a aPattern is a number, the corresponding Number is
- /// constructed and returned.
- /// - If \a aPattern is an atom, the corresponding AtomCons is
- /// constructed and returned.
- /// - If \a aPattern is a list of the form ( _ var ),
- /// where \c var is an atom, lookUp() is called on \c var. Then
- /// the correspoding Variable is constructed and returned.
- /// - If \a aPattern is a list of the form ( _ var expr ),
- /// where \c var is an atom, lookUp() is called on \c var. Then,
- /// \a expr is appended to #iPredicates. Finally, the
- /// correspoding Variable is constructed and returned.
- /// - If \a aPattern is a list of another form, this function
- /// calls itself on any of the entries in this list. The
- /// resulting PatternParameter objects are collected in a
- /// SublistCons, which is returned.
- /// - Otherwise, this function returns #null.
- protected PatternParameter makeParamMatcher(Environment aEnvironment, Cons aPattern) throws Exception {
- if (aPattern == null) {
- return null;
- }
- //LispError.check(aPattern.type().equals("Number"), LispError.INVALID_ARGUMENT);
- if (aPattern.getNumber(aEnvironment.getPrecision()) != null) {
- return new Number((BigNumber) aPattern.getNumber(aEnvironment.getPrecision()));
- }
- // Deal with atoms
- if (aPattern.car() instanceof String) {
- return new Atom( (String) aPattern.car());
- }
-
- // Else it must be a sublist
- if (aPattern.car() instanceof ConsPointer) {
- // See if it is a variable template:
- ConsPointer sublist = (ConsPointer) aPattern.car();
- //LispError.lispAssert(sublist != null);
-
- int num = Utility.listLength(sublist);
-
- // variable matcher here...
- if (num > 1) {
- Cons head = sublist.getCons();
- if (((String) head.car()) == aEnvironment.getTokenHash().lookUp("_")) {
- Cons second = head.cdr().getCons();
- if (second.car() instanceof String) {
- int index = lookUp( (String) second.car());
-
- // Make a predicate for the type, if needed
- if (num > 2) {
- ConsPointer third = new ConsPointer();
-
- Cons predicate = second.cdr().getCons();
- if ( (predicate.car() instanceof ConsPointer)) {
- Utility.flatCopy(aEnvironment, third, (ConsPointer) predicate.car());
- } else {
- third.setCons(second.cdr().getCons().copy( aEnvironment, false));
- }
-
- String str = (String) second.car();
- Cons last = third.getCons();
- while (last.cdr().getCons() != null) {
- last = last.cdr().getCons();
- }
-
- last.cdr().setCons(org.mathpiper.lisp.cons.AtomCons.getInstance(aEnvironment, str));
-
- ConsPointer pred = new ConsPointer();
- pred.setCons(org.mathpiper.lisp.cons.SublistCons.getInstance(aEnvironment,third.getCons()));
-
- iPredicates.add(pred);
- }
- return new Variable(index);
- }
- }
- }
-
- PatternParameter[] matchers = new PatternParameter[num];
-
- int i;
- ConsTraverser consTraverser = new ConsTraverser(sublist);
- for (i = 0; i < num; i++) {
- matchers[i] = makeParamMatcher(aEnvironment, consTraverser.getCons());
- LispError.lispAssert(matchers[i] != null);
- consTraverser.goNext();
- }
- return new Sublist(matchers, num);
- }
-
- return null;
- }
-
- /// Look up a variable name in #iVariables
- /// \returns index in #iVariables array where \a aVariable
- /// appears.
- ///
- /// If \a aVariable is not in #iVariables, it is added.
- protected int lookUp(String aVariable) {
- int i;
- for (i = 0; i < iVariables.size(); i++) {
- if (iVariables.get(i) == aVariable) {
- return i;
- }
- }
- iVariables.add(aVariable);
- return iVariables.size() - 1;
- }
-
- /// Set local variables corresponding to the pattern variables.
- /// This function goes through the #iVariables array. A local
- /// variable is made for every entry in the array, and the
- /// corresponding argument is assigned to it.
- protected void setPatternVariables(Environment aEnvironment, ConsPointer[] arguments) throws Exception {
- int i;
- for (i = 0; i < iVariables.size(); i++) {
- // setCons the variable to the new value
- aEnvironment.newLocalVariable((String) iVariables.get(i), arguments[i].getCons());
- }
- }
-
- /// check whether all predicates are true.
- /// This function goes through all predicates in #iPredicates, and
- /// evaluates them. It returns #false if at least one
- /// of these results IsFalse(). An error is raised if any result
- /// neither IsTrue() nor IsFalse().
- protected boolean checkPredicates(Environment aEnvironment) throws Exception {
- int i;
- for (i = 0; i < iPredicates.size(); i++) {
- ConsPointer pred = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, pred, ((ConsPointer) iPredicates.get(i)));
- if (Utility.isFalse(aEnvironment, pred)) {
- return false;
- }
-
-
- // If the result is not False, it should be True, else probably something is wrong (the expression returned unevaluated)
- boolean isTrue = Utility.isTrue(aEnvironment, pred);
- if (!isTrue) {
- //TODO this is probably not the right way to generate an error, should we perhaps do a full throw new MathPiperException here?
- String strout;
- aEnvironment.write("The predicate\n\t");
- strout = Utility.printExpression(((ConsPointer) iPredicates.get(i)), aEnvironment, 60);
- aEnvironment.write(strout);
- aEnvironment.write("\nevaluated to\n\t");
- strout = Utility.printExpression(pred, aEnvironment, 60);
- aEnvironment.write(strout);
- aEnvironment.write("\n");
-
- LispError.check(isTrue, LispError.NON_BOOLEAN_PREDICATE_IN_PATTERN);
- }
- }
- return true;
- }
-
- public List getParameterMatchers() {
- return iParamMatchers;
- }
-
- public List getPredicates() {
- return iPredicates;
- }
-
- public List getVariables() {
- return iVariables;
- }
-}
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/PatternParameter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/PatternParameter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/PatternParameter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/PatternParameter.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.parametermatchers;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
-
-
-/// Abstract class for matching one argument to a pattern.
-public abstract class PatternParameter
-{
- /// Check whether some expression matches to the pattern.
- /// \param aEnvironment the underlying Lisp environment.
- /// \param aExpression the expression to test.
- /// \param arguments (input/output) actual values of the pattern
- /// variables for \a aExpression.
- public abstract boolean argumentMatches(Environment aEnvironment,
- ConsPointer aExpression,
- ConsPointer[] arguments) throws Exception;
-
- public abstract String getType();
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/PatternParameterMatcher.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/PatternParameterMatcher.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/PatternParameterMatcher.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/PatternParameterMatcher.java 2010-07-18 20:33:50.000000000 +0000
@@ -0,0 +1,36 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.parametermatchers;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+
+//Abstract class for matching one argument to a pattern.
+public abstract class PatternParameterMatcher {
+
+ /**
+ *Check whether some expression matches to the pattern.
+ *@aEnvironment the underlying Lisp environment.
+ *@aExpression the expression to test.
+ *@arguments (input/output) actual values of the pattern variables for aExpression.
+ */
+ public abstract boolean argumentMatches(Environment aEnvironment, int aStackTop, ConsPointer aExpression, ConsPointer[] arguments) throws Exception;
+
+
+ public abstract String getType();
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Sublist.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Sublist.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parametermatchers/Sublist.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parametermatchers/Sublist.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.parametermatchers;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.cons.ConsTraverser;
-import org.mathpiper.lisp.Environment;
-
-
-/// Class for matching against a list of PatternParameter objects.
-public class Sublist extends PatternParameter
-{
- protected PatternParameter[] iMatchers;
- protected int iNrMatchers;
-
- public Sublist(PatternParameter[] aMatchers, int aNrMatchers)
- {
- iMatchers = aMatchers;
- iNrMatchers = aNrMatchers;
- }
-
- public boolean argumentMatches(Environment aEnvironment,
- ConsPointer aExpression,
- ConsPointer[] arguments) throws Exception
- {
- if (!(aExpression.car() instanceof ConsPointer))
- return false;
- int i;
-
- ConsTraverser consTraverser = new ConsTraverser(aExpression);
- consTraverser.goSub();
-
- for (i=0;i 0 && iLookAhead != iEnvironment.iEndStatementAtom.car())
{
- readToken();
+ readToken(aStackTop);
}
}
@@ -96,13 +99,13 @@
{
iSExpressionResult.setCons(null);
}
- LispError.check(!iError, LispError.INVALID_EXPRESSION);
+ LispError.check(iEnvironment, aStackTop, !iError, LispError.INVALID_EXPRESSION, "INTERNAL");
}
- void readToken() throws Exception
+ void readToken(int aStackTop) throws Exception
{
// Get token.
- iLookAhead = iTokenizer.nextToken(iInput,
+ iLookAhead = iTokenizer.nextToken(iEnvironment, aStackTop, iInput,
iEnvironment.getTokenHash());
if (iLookAhead.length() == 0)
{
@@ -110,18 +113,18 @@
}
}
- void matchToken(String aToken) throws Exception
+ void matchToken(int aStackTop, String aToken) throws Exception
{
- if (aToken != iLookAhead)
+ if (!aToken.equals(iLookAhead))
{
- fail();
+ fail(aStackTop);
}
- readToken();
+ readToken(aStackTop);
}
- void readExpression(Environment aEnvironment,int depth) throws Exception
+ void readExpression(Environment aEnvironment,int aStackTop, int depth) throws Exception
{
- readAtom(aEnvironment);
+ readAtom(aEnvironment, aStackTop);
for (;;)
{
@@ -129,30 +132,30 @@
if (iLookAhead == iEnvironment.iProgOpenAtom.car())
{
// Match opening bracket
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
// Read "index" argument
- readExpression(aEnvironment,MathPiperPrinter.KMaxPrecedence);
+ readExpression(aEnvironment, aStackTop, MathPiperPrinter.KMaxPrecedence);
// Match closing bracket
if (iLookAhead != iEnvironment.iProgCloseAtom.car())
{
- LispError.raiseError("Expecting a ] close bracket for program block, but got " + iLookAhead + " instead.");
+ LispError.raiseError("Expecting a ] close bracket for program block, but got " + iLookAhead + " instead.", "[INTERNAL]", aStackTop, aEnvironment);
return;
}
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
// Build into Ntn(...)
String theOperator = (String) iEnvironment.iNthAtom.car();
- insertAtom(theOperator);
- combine(aEnvironment,2);
+ insertAtom(aStackTop, theOperator);
+ combine(aEnvironment,aStackTop, 2);
} else
{
- InfixOperator op = (InfixOperator) iInfixOperators.lookUp(iLookAhead);
+ Operator op = (Operator) iInfixOperators.lookUp(iLookAhead);
if (op == null)
{
//printf("op [%s]\n",iLookAhead.String());
if(iLookAhead.equals(""))
{
- LispError.raiseError("Expression must end with a semi-colon (;)");
+ LispError.raiseError("Expression must end with a semi-colon (;)", "[INTERNAL]", aStackTop, aEnvironment);
return;
}
if (MathPiperTokenizer.isSymbolic(iLookAhead.charAt(0)))
@@ -168,7 +171,7 @@
(String) iEnvironment.getTokenHash().lookUp(iLookAhead.substring(0, len));
//printf("trunc %s\n",lookUp.String());
- op = (InfixOperator) iInfixOperators.lookUp(lookUp);
+ op = (Operator) iInfixOperators.lookUp(lookUp);
//if (op) printf("FOUND\n");
if (op != null)
{
@@ -216,183 +219,183 @@
{
upper--;
}
- getOtherSide(aEnvironment,2, upper);
+ getOtherSide(aEnvironment,aStackTop, 2, upper);
}
}
}
- void readAtom(Environment aEnvironment) throws Exception
+ void readAtom(Environment aEnvironment, int aStackTop) throws Exception
{
- InfixOperator op;
+ Operator op;
// parse prefix operators
- op = (InfixOperator) iPrefixOperators.lookUp(iLookAhead);
+ op = (Operator) iPrefixOperators.lookUp(iLookAhead);
if (op != null)
{
String theOperator = iLookAhead;
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
{
- readExpression(aEnvironment,op.iPrecedence);
- insertAtom(theOperator);
- combine(aEnvironment,1);
+ readExpression(aEnvironment,aStackTop, op.iPrecedence);
+ insertAtom(aStackTop, theOperator);
+ combine(aEnvironment,aStackTop, 1);
}
} // Else parse brackets
else if (iLookAhead == iEnvironment.iBracketOpenAtom.car())
{
- matchToken(iLookAhead);
- readExpression(aEnvironment,MathPiperPrinter.KMaxPrecedence); // least precedence
- matchToken( (String) iEnvironment.iBracketCloseAtom.car());
+ matchToken(aStackTop, iLookAhead);
+ readExpression(aEnvironment,aStackTop, MathPiperPrinter.KMaxPrecedence); // least precedence
+ matchToken( aStackTop, (String) iEnvironment.iBracketCloseAtom.car());
} //parse lists
else if (iLookAhead == iEnvironment.iListOpenAtom.car())
{
int nrargs = 0;
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
while (iLookAhead != iEnvironment.iListCloseAtom.car())
{
- readExpression(aEnvironment,MathPiperPrinter.KMaxPrecedence); // least precedence
+ readExpression(aEnvironment,aStackTop, MathPiperPrinter.KMaxPrecedence); // least precedence
nrargs++;
if (iLookAhead == iEnvironment.iCommaAtom.car())
{
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
} else if (iLookAhead != iEnvironment.iListCloseAtom.car())
{
- LispError.raiseError("Expecting a } close bracket for a list, but got " + iLookAhead + " instead.");
+ LispError.raiseError("Expecting a } close bracket for a list, but got " + iLookAhead + " instead.", "[INTERNAL]", aStackTop, aEnvironment);
return;
}
}
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
String theOperator = (String) iEnvironment.iListAtom.car();
- insertAtom(theOperator);
- combine(aEnvironment, nrargs);
+ insertAtom(aStackTop, theOperator);
+ combine(aEnvironment, aStackTop, nrargs);
} // parse prog bodies
else if (iLookAhead == iEnvironment.iProgOpenAtom.car())
{
int nrargs = 0;
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
while (iLookAhead != iEnvironment.iProgCloseAtom.car())
{
- readExpression(aEnvironment,MathPiperPrinter.KMaxPrecedence); // least precedence
+ readExpression(aEnvironment,aStackTop, MathPiperPrinter.KMaxPrecedence); // least precedence
nrargs++;
if (iLookAhead == iEnvironment.iEndStatementAtom.car())
{
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
} else
{
- LispError.raiseError("Expecting ; end of statement in program block, but got " + iLookAhead + " instead.");
+ LispError.raiseError("Expecting ; end of statement in program block, but got " + iLookAhead + " instead.", "[INTERNAL]", aStackTop, aEnvironment);
return;
}
}
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
String theOperator = (String) iEnvironment.iProgAtom.car();
- insertAtom(theOperator);
+ insertAtom(aStackTop, theOperator);
- combine(aEnvironment, nrargs);
+ combine(aEnvironment, aStackTop, nrargs);
} // Else we have an atom.
else
{
String theOperator = iLookAhead;
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
int nrargs = -1;
if (iLookAhead == iEnvironment.iBracketOpenAtom.car())
{
nrargs = 0;
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
while (iLookAhead != iEnvironment.iBracketCloseAtom.car())
{
- readExpression(aEnvironment,MathPiperPrinter.KMaxPrecedence); // least precedence
+ readExpression(aEnvironment,aStackTop, MathPiperPrinter.KMaxPrecedence); // least precedence
nrargs++;
if (iLookAhead == iEnvironment.iCommaAtom.car())
{
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
} else if (iLookAhead != iEnvironment.iBracketCloseAtom.car())
{
- LispError.raiseError("Expecting ) closing bracket for sub-expression, but got " + iLookAhead + " instead.");
+ LispError.raiseError("Expecting ) closing bracket for sub-expression, but got " + iLookAhead + " instead.", "[INTERNAL]", aStackTop, aEnvironment);
return;
}
}
- matchToken(iLookAhead);
+ matchToken(aStackTop, iLookAhead);
- op = (InfixOperator) iBodiedOperators.lookUp(theOperator);
+ op = (Operator) iBodiedOperators.lookUp(theOperator);
if (op != null)
{
- readExpression(aEnvironment,op.iPrecedence); // MathPiperPrinter.KMaxPrecedence
+ readExpression(aEnvironment,aStackTop, op.iPrecedence); // MathPiperPrinter.KMaxPrecedence
nrargs++;
}
}
- insertAtom(theOperator);
+ insertAtom(aStackTop, theOperator);
if (nrargs >= 0)
{
- combine(aEnvironment, nrargs);
+ combine(aEnvironment, aStackTop, nrargs);
}
}
// parse postfix operators
- while ((op = (InfixOperator) iPostfixOperators.lookUp(iLookAhead)) != null)
+ while ((op = (Operator) iPostfixOperators.lookUp(iLookAhead)) != null)
{
- insertAtom(iLookAhead);
- matchToken(iLookAhead);
- combine(aEnvironment,1);
+ insertAtom(aStackTop, iLookAhead);
+ matchToken(aStackTop, iLookAhead);
+ combine(aEnvironment,aStackTop, 1);
}
}
- void getOtherSide(Environment aEnvironment,int aNrArgsToCombine, int depth) throws Exception
+ void getOtherSide(Environment aEnvironment, int aStackTop, int aNrArgsToCombine, int depth) throws Exception
{
String theOperator = iLookAhead;
- matchToken(iLookAhead);
- readExpression(aEnvironment, depth);
- insertAtom(theOperator);
- combine(aEnvironment, aNrArgsToCombine);
+ matchToken(aStackTop, iLookAhead);
+ readExpression(aEnvironment, aStackTop, depth);
+ insertAtom(aStackTop, theOperator);
+ combine(aEnvironment, aStackTop, aNrArgsToCombine);
}
- void combine(Environment aEnvironment,int aNrArgsToCombine) throws Exception
+ void combine(Environment aEnvironment, int aStackTop, int aNrArgsToCombine) throws Exception
{
ConsPointer subList = new ConsPointer();
subList.setCons(SublistCons.getInstance(aEnvironment,iSExpressionResult.getCons()));
- ConsTraverser consTraverser = new ConsTraverser(iSExpressionResult);
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, iSExpressionResult);
int i;
for (i = 0; i < aNrArgsToCombine; i++)
{
if (consTraverser.getCons() == null)
{
- fail();
+ fail(aStackTop);
return;
}
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop);
}
if (consTraverser.getCons() == null)
{
- fail();
+ fail(aStackTop);
return;
}
subList.cdr().setCons(consTraverser.cdr().getCons());
consTraverser.cdr().setCons(null);
- Utility.reverseList(((ConsPointer) subList.car()).cdr(),
+ Utility.reverseList(aEnvironment, ((ConsPointer) subList.car()).cdr(),
((ConsPointer) subList.car()).cdr());
iSExpressionResult.setCons(subList.getCons());
}
- void insertAtom(String aString) throws Exception
+ void insertAtom(int aStackTop, String aString) throws Exception
{
ConsPointer ptr = new ConsPointer();
- ptr.setCons(AtomCons.getInstance(iEnvironment, aString));
+ ptr.setCons(AtomCons.getInstance(iEnvironment, aStackTop, aString));
ptr.cdr().setCons(iSExpressionResult.getCons());
iSExpressionResult.setCons(ptr.getCons());
}
- void fail() throws Exception // called when parsing fails, raising an exception
+ void fail(int aStackTop) throws Exception // called when parsing fails, raising an exception
{
iError = true;
if (iLookAhead != null)
{
- LispError.raiseError("Error parsing expression, near token " + iLookAhead + ".");
+ LispError.raiseError("Error parsing expression, near token " + iLookAhead + ".", "[INTERNAL]", aStackTop, iEnvironment);
}
- LispError.raiseError("Error parsing expression.");
+ LispError.raiseError("Error parsing expression.", "[INTERNAL]", aStackTop, iEnvironment);
}
};
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parsers/Parser.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parsers/Parser.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/parsers/Parser.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/parsers/Parser.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,9 +13,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.parsers;
import org.mathpiper.lisp.cons.SublistCons;
@@ -25,84 +23,80 @@
import org.mathpiper.io.MathPiperInputStream;
import org.mathpiper.lisp.*;
+public class Parser {
-public class Parser
-{
- public MathPiperTokenizer iTokenizer;
- public MathPiperInputStream iInput;
- public Environment iEnvironment;
- public boolean iListed;
-
- public Parser(MathPiperTokenizer aTokenizer, MathPiperInputStream aInput,
- Environment aEnvironment)
- {
- iTokenizer = aTokenizer;
- iInput = aInput;
- iEnvironment = aEnvironment;
- iListed = false;
- }
-
- public void parse(Environment aEnvironment,ConsPointer aResult ) throws Exception
- {
- aResult.setCons(null);
-
- String token;
- // Get token.
- token = iTokenizer.nextToken(iInput,iEnvironment.getTokenHash());
- if (token.length() == 0) //TODO FIXME either token == null or token.length() == 0?
- {
- aResult.setCons(AtomCons.getInstance(iEnvironment,"EndOfFile"));
- return;
- }
- parseAtom(aEnvironment,aResult, token);
- }
-
- void parseList(Environment aEnvironment,ConsPointer aResult) throws Exception
- {
- String token;
-
- ConsPointer iter = aResult;
- if (iListed)
- {
- aResult.setCons(AtomCons.getInstance(iEnvironment,"List"));
- iter = (aResult.cdr()); //TODO FIXME
- }
- for (;;)
- {
- //Get token.
- token = iTokenizer.nextToken(iInput,iEnvironment.getTokenHash());
- // if token is empty string, error!
- LispError.check(token.length() > 0,LispError.INVALID_TOKEN); //TODO FIXME
- // if token is ")" return result.
- if (token == iEnvironment.getTokenHash().lookUp(")"))
- {
- return;
- }
- // else parse simple atom with parse, and append it to the
- // results list.
-
- parseAtom(aEnvironment,iter, token);
- iter = (iter.cdr()); //TODO FIXME
- }
- }
-
- void parseAtom(Environment aEnvironment,ConsPointer aResult,String aToken) throws Exception
- {
- // if token is empty string, return null pointer (no expression)
- if (aToken.length() == 0) //TODO FIXME either token == null or token.length() == 0?
- return;
- // else if token is "(" read in a whole array of objects until ")",
- // and make a sublist
- if (aToken == iEnvironment.getTokenHash().lookUp("("))
- {
- ConsPointer subList = new ConsPointer();
- parseList(aEnvironment, subList);
- aResult.setCons(SublistCons.getInstance(aEnvironment,subList.getCons()));
- return;
- }
- // else make a simple atom, and return it.
- aResult.setCons(AtomCons.getInstance(iEnvironment,aToken));
- }
-
-}
+ public MathPiperTokenizer iTokenizer;
+ public MathPiperInputStream iInput;
+ public Environment iEnvironment;
+ public boolean iListed;
+
+
+ public Parser(MathPiperTokenizer aTokenizer, MathPiperInputStream aInput,
+ Environment aEnvironment) {
+ iTokenizer = aTokenizer;
+ iInput = aInput;
+ iEnvironment = aEnvironment;
+ iListed = false;
+ }
+
+
+ public void parse(int aStackTop, ConsPointer aResult) throws Exception {
+ aResult.setCons(null);
+
+ String token;
+ // Get token.
+ token = iTokenizer.nextToken(iEnvironment, aStackTop, iInput, iEnvironment.getTokenHash());
+ if (token.length() == 0) //TODO FIXME either token == null or token.length() == 0?
+ {
+ aResult.setCons(AtomCons.getInstance(iEnvironment, aStackTop, "EndOfFile"));
+ return;
+ }
+ parseAtom(iEnvironment, aStackTop, aResult, token);
+ }
+
+
+ void parseList(Environment aEnvironment, int aStackTop, ConsPointer aResult) throws Exception {
+ String token;
+
+ ConsPointer iter = aResult;
+ if (iListed) {
+ aResult.setCons(AtomCons.getInstance(iEnvironment, aStackTop, "List"));
+ iter = (aResult.cdr()); //TODO FIXME
+ }
+ for (;;) {
+ //Get token.
+ token = iTokenizer.nextToken(iEnvironment, aStackTop, iInput, iEnvironment.getTokenHash());
+ // if token is empty string, error!
+ LispError.check(iEnvironment, aStackTop, token.length() > 0, LispError.INVALID_TOKEN, "INTERNAL"); //TODO FIXME
+ // if token is ")" return result.
+ if (token == iEnvironment.getTokenHash().lookUp(")")) {
+ return;
+ }
+ // else parse simple atom with parse, and append it to the
+ // results list.
+
+ parseAtom(aEnvironment, aStackTop, iter, token);
+ iter = (iter.cdr()); //TODO FIXME
+ }
+ }
+
+
+ void parseAtom(Environment aEnvironment, int aStackTop, ConsPointer aResult, String aToken) throws Exception {
+ // if token is empty string, return null pointer (no expression)
+ if (aToken.length() == 0) //TODO FIXME either token == null or token.length() == 0?
+ {
+ return;
+ }
+ // else if token is "(" read in a whole array of objects until ")",
+ // and make a sublist
+ if (aToken == iEnvironment.getTokenHash().lookUp("(")) {
+ ConsPointer subList = new ConsPointer();
+ parseList(aEnvironment, aStackTop, subList);
+ aResult.setCons(SublistCons.getInstance(aEnvironment, subList.getCons()));
+ return;
+ }
+ // else make a simple atom, and return it.
+ aResult.setCons(AtomCons.getInstance(iEnvironment, aStackTop, aToken));
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/printers/LispPrinter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/printers/LispPrinter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/printers/LispPrinter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/printers/LispPrinter.java 2010-12-29 04:07:15.000000000 +0000
@@ -16,21 +16,14 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.printers;
-
-import java.util.ArrayList;
-import java.util.List;
import org.mathpiper.lisp.cons.ConsPointer;
import org.mathpiper.lisp.*;
import org.mathpiper.io.MathPiperOutputStream;
-import org.mathpiper.lisp.cons.Cons;
-
public class LispPrinter {
//private List visitedLists = new ArrayList();
-
-
- public void print(ConsPointer aExpression, MathPiperOutputStream aOutput, Environment aEnvironment) throws Exception {
+ public void print(int aStackTop, ConsPointer aExpression, MathPiperOutputStream aOutput, Environment aEnvironment) throws Exception {
printExpression(aExpression, aOutput, aEnvironment, 0);
//visitedLists.clear();
@@ -61,18 +54,18 @@
/*
Cons atomCons = (Cons) consWalker.getCons();
if (visitedLists.contains(atomCons)) {
- aOutput.write("(CYCLE_LIST)");
+ aOutput.write("(CYCLE_LIST)");
} else {
- visitedLists.add(atomCons);*/
+ visitedLists.add(atomCons);*/
- if (item != 0) {
- indent(aOutput, aDepth + 1);
- }
- aOutput.write("(");
- printExpression(((ConsPointer) consWalker.car()), aOutput, aEnvironment, aDepth + 1);
- aOutput.write(")");
- item = 0;
+ if (item != 0) {
+ indent(aOutput, aDepth + 1);
+ }
+ aOutput.write("(");
+ printExpression(((ConsPointer) consWalker.car()), aOutput, aEnvironment, aDepth + 1);
+ aOutput.write(")");
+ item = 0;
//}
@@ -94,7 +87,4 @@
}
}
-
};
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/printers/MathPiperPrinter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/printers/MathPiperPrinter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/printers/MathPiperPrinter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/printers/MathPiperPrinter.java 2010-12-29 04:07:15.000000000 +0000
@@ -16,9 +16,6 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.printers;
-
-import java.util.ArrayList;
-import java.util.List;
import org.mathpiper.builtin.BuiltinContainer;
import org.mathpiper.io.MathPiperOutputStream;
import org.mathpiper.lisp.Utility;
@@ -27,10 +24,8 @@
import org.mathpiper.lisp.cons.ConsTraverser;
import org.mathpiper.lisp.Environment;
import org.mathpiper.lisp.tokenizers.MathPiperTokenizer;
-import org.mathpiper.lisp.InfixOperator;
+import org.mathpiper.lisp.Operator;
import org.mathpiper.lisp.collections.OperatorMap;
-import org.mathpiper.lisp.cons.Cons;
-
public class MathPiperPrinter extends LispPrinter {
@@ -44,8 +39,6 @@
Environment iCurrentEnvironment;
//private List visitedLists = new ArrayList();
-
-
public MathPiperPrinter(OperatorMap aPrefixOperators,
OperatorMap aInfixOperators,
OperatorMap aPostfixOperators,
@@ -57,41 +50,39 @@
iPrevLastChar = 0;
}
-
-
-
- public void print(ConsPointer aExpression, MathPiperOutputStream aOutput, Environment aEnvironment) throws Exception {
+ @Override
+ public void print(int aStackTop, ConsPointer aExpression, MathPiperOutputStream aOutput, Environment aEnvironment) throws Exception {
iCurrentEnvironment = aEnvironment;
- Print(aExpression, aOutput, KMaxPrecedence);
+ Print(aEnvironment, aStackTop, aExpression, aOutput, KMaxPrecedence);
//visitedLists.clear();
}
-
+ @Override
public void rememberLastChar(char aChar) {
iPrevLastChar = aChar;
}
+ void Print(Environment aEnvironment, int aStackTop, ConsPointer aExpression, MathPiperOutputStream aOutput, int iPrecedence) throws Exception {
- void Print(ConsPointer aExpression, MathPiperOutputStream aOutput, int iPrecedence) throws Exception {
-
- LispError.lispAssert(aExpression.getCons() != null);
+ LispError.lispAssert(aExpression.getCons() != null, aEnvironment, aStackTop);
- String string;
+ String functionOrOperatorName;
if (aExpression.car() instanceof String) {
- string = (String) aExpression.car();
+ functionOrOperatorName = (String) aExpression.car();
boolean bracket = false;
if (iPrecedence < KMaxPrecedence &&
- string.charAt(0) == '-' &&
- (MathPiperTokenizer.isDigit(string.charAt(1)) || string.charAt(1) == '.')) {
+ functionOrOperatorName.charAt(0) == '-' &&
+ (MathPiperTokenizer.isDigit(functionOrOperatorName.charAt(1)) || functionOrOperatorName.charAt(1) == '.')) {
+ //Code for (-1)/2 .
bracket = true;
}
if (bracket) {
WriteToken(aOutput, "(");
}
- WriteToken(aOutput, string);
+ WriteToken(aOutput, functionOrOperatorName);
if (bracket) {
WriteToken(aOutput, ")");
}
@@ -100,24 +91,24 @@
if (aExpression.car() instanceof BuiltinContainer) {
//TODO display genericclass
- WriteToken(aOutput, ((BuiltinContainer) aExpression.car()).typeName());
+ WriteToken(aOutput, ((BuiltinContainer) aExpression.car()).getObject().getClass().toString());
return;
}
ConsPointer subList = (ConsPointer) aExpression.car();
- LispError.check(subList != null, LispError.UNPRINTABLE_TOKEN);
+ LispError.check(aEnvironment, aStackTop, subList != null, LispError.UNPRINTABLE_TOKEN, "INTERNAL");
if (subList.getCons() == null) {
WriteToken(aOutput, "( )");
} else {
- int length = Utility.listLength(subList);
- string = (String) subList.car();
- InfixOperator prefix = (InfixOperator) iPrefixOperators.lookUp(string);
- InfixOperator infix = (InfixOperator) iInfixOperators.lookUp(string);
- InfixOperator postfix = (InfixOperator) iPostfixOperators.lookUp(string);
- InfixOperator bodied = (InfixOperator) iBodiedOperators.lookUp(string);
- InfixOperator op = null;
+ int length = Utility.listLength(aEnvironment, aStackTop, subList);
+ functionOrOperatorName = (String) subList.car();
+ Operator prefix = (Operator) iPrefixOperators.lookUp(functionOrOperatorName);
+ Operator infix = (Operator) iInfixOperators.lookUp(functionOrOperatorName);
+ Operator postfix = (Operator) iPostfixOperators.lookUp(functionOrOperatorName);
+ Operator bodied = (Operator) iBodiedOperators.lookUp(functionOrOperatorName);
+ Operator operator = null;
if (length != 2) {
prefix = null;
@@ -127,16 +118,16 @@
infix = null;
}
if (prefix != null) {
- op = prefix;
+ operator = prefix;
}
if (postfix != null) {
- op = postfix;
+ operator = postfix;
}
if (infix != null) {
- op = infix;
+ operator = infix;
}
- if (op != null) {
+ if (operator != null) {
ConsPointer left = null;
ConsPointer right = null;
@@ -149,49 +140,114 @@
left = subList.cdr();
}
- if (iPrecedence < op.iPrecedence) {
+ if (iPrecedence < operator.iPrecedence) {
WriteToken(aOutput, "(");
} else {
//Vladimir? aOutput.write(" ");
}
+
if (left != null) {
- Print(left, aOutput, op.iLeftPrecedence);
+
+ if (functionOrOperatorName.equals("/") && Utility.functionType(left).equals("/")) {
+ //Code for In> Hold((3/2)/(1/2)) Result> (3/2)/(1/2) .
+ WriteToken(aOutput, "(");
+ }//end if.
+
+ Print(aEnvironment, aStackTop, left, aOutput, operator.iLeftPrecedence);
+
+ if (functionOrOperatorName.equals("/") && Utility.functionType(left).equals("/")) {
+ //Code for In> Hold((3/2)/(1/2)) Result> (3/2)/(1/2) .
+ WriteToken(aOutput, ")");
+ }//end if.
+ }
+
+ boolean addSpaceAroundInfixOperator = false; //Todo:tk:perhaps a more general way should be found to place a space after a prefix operator.
+ if(functionOrOperatorName.equals("And"))
+ {
+ addSpaceAroundInfixOperator = true;
}
- WriteToken(aOutput, string);
+
+ if (addSpaceAroundInfixOperator == true) {
+ WriteToken(aOutput, " ");
+ }//end if.
+
+ WriteToken(aOutput, functionOrOperatorName);
+
+ if (addSpaceAroundInfixOperator == true) {
+ WriteToken(aOutput, " ");
+ }//end if.
+
if (right != null) {
- Print(right, aOutput, op.iRightPrecedence);
+
+ if (functionOrOperatorName.equals("/") && Utility.functionType(right).equals("/")) {
+ //Code for In> Hold((3/2)/(1/2)) Result> (3/2)/(1/2) .
+ WriteToken(aOutput, "(");
+ }//end if.
+
+ if (functionOrOperatorName.equals("Not")) {//Todo:tk:perhaps a more general way should be found to place a space after a prefix operator.
+ WriteToken(aOutput, " ");
+ }//end if.
+
+ Print(aEnvironment, aStackTop, right, aOutput, operator.iRightPrecedence);
+
+ if (functionOrOperatorName.equals("/") && Utility.functionType(right).equals("/")) {
+ //Code for In> Hold((3/2)/(1/2)) Result> (3/2)/(1/2) .
+ WriteToken(aOutput, ")");
+ }//end if.
}
- if (iPrecedence < op.iPrecedence) {
+
+ if (iPrecedence < operator.iPrecedence) {
WriteToken(aOutput, ")");
}
+
} else {
- ConsTraverser consTraverser = new ConsTraverser(subList.cdr());
- if (string == iCurrentEnvironment.iListAtom.car()) {
+
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, subList.cdr());
+
+ /*
+ Removing complex number output notation formatting until the problem with Solve(x^3 - 2*x - 7 == 0,x) is resolved.
+
+ if (functionOrOperatorName == iCurrentEnvironment.iComplexAtom.car()) {
+
+ Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
+
+ consTraverser.goNext(); //Point to second argument.
+
+ if (!consTraverser.car().toString().startsWith("-")) {
+ WriteToken(aOutput, "+");
+ }
+
+ Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
+
+ WriteToken(aOutput, "*I");
+
+ } else */
+ if (functionOrOperatorName == iCurrentEnvironment.iListAtom.car()) {
/*
Cons atomCons = (Cons) subList.getCons();
if (visitedLists.contains(atomCons)) {
- WriteToken(aOutput, "{CYCLE_LIST}");
- return;
+ WriteToken(aOutput, "{CYCLE_LIST}");
+ return;
} else {
- visitedLists.add(atomCons);*/
+ visitedLists.add(atomCons);*/
- WriteToken(aOutput, "{");
+ WriteToken(aOutput, "{");
- while (consTraverser.getCons() != null) {
- Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
- consTraverser.goNext();
- if (consTraverser.getCons() != null) {
- WriteToken(aOutput, ",");
- }
- }//end while.
+ while (consTraverser.getCons() != null) {
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, KMaxPrecedence);
+ consTraverser.goNext(aStackTop);
+ if (consTraverser.getCons() != null) {
+ WriteToken(aOutput, ",");
+ }
+ }//end while.
- WriteToken(aOutput, "}");
+ WriteToken(aOutput, "}");
- // }//end else.
- } else if (string == iCurrentEnvironment.iProgAtom.car()) // Program block brackets.
+ // }//end else.
+ } else if (functionOrOperatorName == iCurrentEnvironment.iProgAtom.car()) // Program block brackets.
{
WriteToken(aOutput, "[");
aOutput.write("\n");
@@ -199,8 +255,8 @@
while (consTraverser.getCons() != null) {
aOutput.write(spaces.toString());
- Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
- consTraverser.goNext();
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, KMaxPrecedence);
+ consTraverser.goNext(aStackTop);
WriteToken(aOutput, ";");
aOutput.write("\n");
}
@@ -208,11 +264,11 @@
WriteToken(aOutput, "]");
aOutput.write("\n");
spaces.delete(0, 4);
- } else if (string == iCurrentEnvironment.iNthAtom.car()) {
- Print(consTraverser.getPointer(), aOutput, 0);
- consTraverser.goNext();
+ } else if (functionOrOperatorName == iCurrentEnvironment.iNthAtom.car()) {
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, 0);
+ consTraverser.goNext(aStackTop);
WriteToken(aOutput, "[");
- Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, KMaxPrecedence);
WriteToken(aOutput, "]");
} else {
boolean bracket = false;
@@ -225,18 +281,18 @@
if (bracket) {
WriteToken(aOutput, "(");
}
- if (string != null) {
- WriteToken(aOutput, string);
+ if (functionOrOperatorName != null) {
+ WriteToken(aOutput, functionOrOperatorName); //Print function name.
} else {
- Print(subList, aOutput, 0);
+ Print(aEnvironment, aStackTop, subList, aOutput, 0);
}
- WriteToken(aOutput, "(");
+ WriteToken(aOutput, "("); //Print the opening parenthese of the function argument list.
- ConsTraverser counter = new ConsTraverser(consTraverser.getPointer());
+ ConsTraverser counter = new ConsTraverser(aEnvironment, consTraverser.getPointer());
int nr = 0;
- while (counter.getCons() != null) {
- counter.goNext();
+ while (counter.getCons() != null) { //Count arguments.
+ counter.goNext(aStackTop);
nr++;
}
@@ -244,27 +300,29 @@
nr--;
}
while (nr-- != 0) {
- Print(consTraverser.getPointer(), aOutput, KMaxPrecedence);
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, KMaxPrecedence); //Print argument.
+
+ consTraverser.goNext(aStackTop);
- consTraverser.goNext();
if (nr != 0) {
- WriteToken(aOutput, ",");
+ WriteToken(aOutput, ","); //Print the comma which is between arguments.
}
- }
+ }//end while.
+
WriteToken(aOutput, ")");
+
if (consTraverser.getCons() != null) {
- Print(consTraverser.getPointer(), aOutput, bodied.iPrecedence);
+ Print(aEnvironment, aStackTop, consTraverser.getPointer(), aOutput, bodied.iPrecedence);
}
if (bracket) {
- WriteToken(aOutput, ")");
+ WriteToken(aOutput, ")"); //Print the closing parenthese of the function argument list.
}
}
}
}//end sublist if.
}
-
void WriteToken(MathPiperOutputStream aOutput, String aString) throws Exception {
/*if (MathPiperTokenizer.isAlNum(iPrevLastChar) && (MathPiperTokenizer.isAlNum(aString.charAt(0)) || aString.charAt(0)=='_'))
{
@@ -277,6 +335,4 @@
aOutput.write(aString);
rememberLastChar(aString.charAt(aString.length() - 1));
}
-
-
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ListedMacroRulebase.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ListedMacroRulebase.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ListedMacroRulebase.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ListedMacroRulebase.java 2011-01-29 01:58:56.000000000 +0000
@@ -0,0 +1,66 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.cons.ConsTraverser;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.SublistCons;
+
+public class ListedMacroRulebase extends MacroRulebase {
+
+ public ListedMacroRulebase(Environment aEnvironment, int aStackTop, ConsPointer aParameters, String functionName) throws Exception {
+ super(aEnvironment, aStackTop, aParameters, functionName);
+ }
+
+
+ @Override
+ public boolean isArity(int aArity) {
+ return (arity() <= aArity);
+ }
+
+
+ @Override
+ public void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArguments) throws Exception {
+ ConsPointer newArgs = new ConsPointer();
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, aArguments);
+ ConsPointer ptr = newArgs;
+ int arity = arity();
+ int i = 0;
+ while (i < arity && consTraverser.getCons() != null) {
+ ptr.setCons(consTraverser.getCons().copy(aEnvironment, false));
+ ptr = (ptr.cdr());
+ i++;
+ consTraverser.goNext(aStackTop);
+ }
+ if (consTraverser.cdr().getCons() == null) {
+ ptr.setCons(consTraverser.getCons().copy(aEnvironment, false));
+ ptr = (ptr.cdr());
+ i++;
+ consTraverser.goNext(aStackTop);
+ LispError.lispAssert(consTraverser.getCons() == null, aEnvironment, aStackTop);
+ } else {
+ ConsPointer head = new ConsPointer();
+ head.setCons(aEnvironment.iListAtom.copy(aEnvironment, false));
+ head.cdr().setCons(consTraverser.getCons());
+ ptr.setCons(SublistCons.getInstance(aEnvironment, head.getCons()));
+ }
+ super.evaluate(aEnvironment, aStackTop, aResult, newArgs);
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ListedRulebase.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ListedRulebase.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ListedRulebase.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ListedRulebase.java 2011-01-29 01:58:56.000000000 +0000
@@ -0,0 +1,66 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.cons.ConsTraverser;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.SublistCons;
+
+public class ListedRulebase extends SingleArityRulebase {
+
+ public ListedRulebase(Environment aEnvironment, int aStackTop, ConsPointer aParameters, String functionName) throws Exception {
+ super(aEnvironment, aStackTop, aParameters, functionName);
+ }
+
+
+ @Override
+ public boolean isArity(int aArity) {
+ return (arity() <= aArity);
+ }
+
+
+ @Override
+ public void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArguments) throws Exception {
+ ConsPointer newArgs = new ConsPointer();
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, aArguments);
+ ConsPointer ptr = newArgs;
+ int arity = arity();
+ int i = 0;
+ while (i < arity && consTraverser.getCons() != null) {
+ ptr.setCons(consTraverser.getCons().copy(aEnvironment, false));
+ ptr = (ptr.cdr());
+ i++;
+ consTraverser.goNext(aStackTop);
+ }
+ if (consTraverser.cdr().getCons() == null) {
+ ptr.setCons(consTraverser.getCons().copy(aEnvironment, false));
+ ptr = (ptr.cdr());
+ i++;
+ consTraverser.goNext(aStackTop);
+ LispError.lispAssert(consTraverser.getCons() == null, aEnvironment, aStackTop);
+ } else {
+ ConsPointer head = new ConsPointer();
+ head.setCons(aEnvironment.iListAtom.copy(aEnvironment, false));
+ head.cdr().setCons(consTraverser.getCons());
+ ptr.setCons(SublistCons.getInstance(aEnvironment, head.getCons()));
+ }
+ super.evaluate(aEnvironment, aStackTop, aResult, newArgs);
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/MacroRulebase.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/MacroRulebase.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/MacroRulebase.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/MacroRulebase.java 2011-02-02 08:39:53.000000000 +0000
@@ -0,0 +1,162 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.exceptions.EvaluationException;
+import org.mathpiper.lisp.stacks.UserStackInformation;
+import org.mathpiper.lisp.behaviours.BackQuoteSubstitute;
+import org.mathpiper.lisp.Utility;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.cons.ConsTraverser;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.Evaluator;
+import org.mathpiper.lisp.LispExpressionEvaluator;
+import org.mathpiper.lisp.cons.SublistCons;
+
+public class MacroRulebase extends SingleArityRulebase {
+
+ public MacroRulebase(Environment aEnvironment, int aStackTop, ConsPointer aParameters, String functionName) throws Exception {
+ super(aEnvironment, aStackTop, aParameters, functionName);
+ ConsTraverser parameterTraverser = new ConsTraverser(aEnvironment, aParameters);
+ int i = 0;
+ while (parameterTraverser.getCons() != null) {
+
+ //LispError.check(parameterTraverser.car() != null, LispError.CREATING_USER_FUNCTION);
+ try {
+ LispError.check(aEnvironment, aStackTop, parameterTraverser.car() instanceof String, LispError.CREATING_USER_FUNCTION, "INTERNAL");
+ } catch (EvaluationException ex) {
+ if (ex.getFunctionName() == null) {
+ throw new EvaluationException(ex.getMessage() + " In function: " + this.functionName + ", ", "none", -1, this.functionName);
+ } else {
+ throw ex;
+ }
+ }//end catch.
+
+
+ ((ParameterName) iParameters.get(i)).iHold = true;
+ parameterTraverser.goNext(aStackTop);
+ i++;
+ }
+ //Macros are all unfenced.
+ unFence();
+
+ this.functionType = "macro";
+ }
+
+
+ @Override
+ public void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArgumentsPointer) throws Exception {
+ int arity = arity();
+ ConsPointer[] argumentsResultPointerArray = evaluateArguments(aEnvironment, aStackTop, aArgumentsPointer);
+
+
+
+ ConsPointer substitutedBodyPointer = new ConsPointer();
+
+ //Create a new local variable frame that is unfenced (false = unfenced).
+ aEnvironment.pushLocalFrame(false, this.functionName);
+
+ try {
+ // define the local variables.
+ for (int parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
+ String variable = ((ParameterName) iParameters.get(parameterIndex)).iName;
+
+ // set the variable to the new value
+ aEnvironment.newLocalVariable(variable, argumentsResultPointerArray[parameterIndex].getCons(), aStackTop);
+ }
+
+ // walk the rules database, returning the evaluated result if the
+ // predicate is true.
+ int numberOfRules = iBranchRules.size();
+ UserStackInformation userStackInformation = aEnvironment.iLispExpressionEvaluator.stackInformation();
+ for (int ruleIndex = 0; ruleIndex < numberOfRules; ruleIndex++) {
+ Rule thisRule = ((Rule) iBranchRules.get(ruleIndex));
+ //TODO remove CHECKPTR(thisRule);
+ LispError.lispAssert(thisRule != null, aEnvironment, aStackTop);
+
+ userStackInformation.iRulePrecedence = thisRule.getPrecedence();
+
+ boolean matches = thisRule.matches(aEnvironment, aStackTop, argumentsResultPointerArray);
+
+ if (matches) {
+ /* Rule dump trace code. */
+ if (isTraced() && showFlag) {
+ ConsPointer argumentsPointer = new ConsPointer();
+ argumentsPointer.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String ruleDump = org.mathpiper.lisp.Utility.dumpRule(aStackTop, thisRule, aEnvironment, this);
+ Evaluator.traceShowRule(aEnvironment, argumentsPointer, ruleDump);
+ }
+ userStackInformation.iSide = 1;
+
+ BackQuoteSubstitute backQuoteSubstitute = new BackQuoteSubstitute(aEnvironment);
+
+ ConsPointer originalBodyPointer = thisRule.getBodyPointer();
+ Utility.substitute(aEnvironment, aStackTop, substitutedBodyPointer, originalBodyPointer, backQuoteSubstitute);
+ // aEnvironment.iLispExpressionEvaluator.Eval(aEnvironment, aResult, thisRule.body());
+ break;
+ }
+
+ // If rules got inserted, walk back
+ while (thisRule != ((Rule) iBranchRules.get(ruleIndex)) && ruleIndex > 0) {
+ ruleIndex--;
+ }
+ }
+ } catch (EvaluationException ex) {
+ if (ex.getFunctionName() == null) {
+ throw new EvaluationException(ex.getMessage() + " In function: " + this.functionName + ", ", "none", -1, this.functionName);
+ } else {
+ throw ex;
+ }
+ } finally {
+ aEnvironment.popLocalFrame(aStackTop);
+ }
+
+
+
+ if (substitutedBodyPointer.getCons() != null) {
+ //Note:tk:substituted body must be evaluated after the local frame has been popped.
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, aResult, substitutedBodyPointer);
+ } else // No predicate was true: return a new expression with the evaluated
+ // arguments.
+ {
+ ConsPointer full = new ConsPointer();
+ full.setCons(aArgumentsPointer.getCons().copy(aEnvironment, false));
+ if (arity == 0) {
+ full.cdr().setCons(null);
+ } else {
+ full.cdr().setCons(argumentsResultPointerArray[0].getCons());
+ for (int parameterIndex = 0; parameterIndex < arity - 1; parameterIndex++) {
+ argumentsResultPointerArray[parameterIndex].cdr().setCons(argumentsResultPointerArray[parameterIndex + 1].getCons());
+ }
+ }
+ aResult.setCons(SublistCons.getInstance(aEnvironment, full.getCons()));
+ }
+ //FINISH:
+
+ /*Leave trace code */
+ if (isTraced() && showFlag) {
+ ConsPointer tr = new ConsPointer();
+ tr.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String localVariables = aEnvironment.getLocalVariables(aStackTop);
+ LispExpressionEvaluator.traceShowLeave(aEnvironment, aResult, tr, "macro", localVariables);
+ tr.setCons(null);
+ }
+
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/MultipleArityRulebase.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/MultipleArityRulebase.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/MultipleArityRulebase.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/MultipleArityRulebase.java 2011-01-29 01:58:56.000000000 +0000
@@ -0,0 +1,120 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.*;
+import java.util.*;
+
+/**
+ * Holds a set of {@link SingleArityRulebase} which are associated with one function name.
+ * A specific SingleArityRulebase can be selected by providing its name. The
+ * name of the file in which the function is defined can also be specified.
+ */
+public class MultipleArityRulebase {
+
+ /// Set of SingleArityRulebase's provided by this MultipleArityRulebase.
+ List iFunctions = new ArrayList();//
+ /// File to read for the definition of this function.
+ public DefFile iFileToOpen;
+ public String iFileLocation;
+
+
+ public MultipleArityRulebase() {
+ iFileToOpen = null;
+ }
+
+
+ /**
+ *Return user function with given arity.
+ */
+ public SingleArityRulebase getUserFunction(int aArity, int aStackTop, Environment aEnvironment) throws Exception {
+ int ruleIndex;
+ //Find function body with the right arity
+ int numberOfRules = iFunctions.size();
+ for (ruleIndex = 0; ruleIndex < numberOfRules; ruleIndex++) {
+ LispError.lispAssert(iFunctions.get(ruleIndex) != null, aEnvironment, aStackTop);
+
+ if (((SingleArityRulebase) iFunctions.get(ruleIndex)).isArity(aArity)) {
+ return (SingleArityRulebase) iFunctions.get(ruleIndex);
+ }
+ }
+
+ // If function not found, just unaccept!
+ // User-defined function not found! Returning null
+ return null;
+
+ }//end method.
+
+
+ /**
+ * Specify that some argument should be held.
+ */
+ public void holdArgument(String aVariable, int aStackTop, Environment aEnvironment) throws Exception {
+ int ruleIndex;
+ for (ruleIndex = 0; ruleIndex < iFunctions.size(); ruleIndex++) {
+ LispError.lispAssert(iFunctions.get(ruleIndex) != null, aEnvironment, aStackTop);
+ ((SingleArityRulebase) iFunctions.get(ruleIndex)).holdArgument(aVariable);
+ }
+ }//end method.
+
+
+ /**
+ *Add another SingleArityRulebase to #iFunctions.
+ */
+ public void addRulebaseEntry(Environment aEnvironment, int aStackTop, SingleArityRulebase aNewFunction) throws Exception {
+ int ruleIndex;
+ //Find function body with the right arity
+ int numberOfRules = iFunctions.size();
+ for (ruleIndex = 0; ruleIndex < numberOfRules; ruleIndex++) {
+ LispError.lispAssert(((SingleArityRulebase) iFunctions.get(ruleIndex)) != null, aEnvironment, aStackTop);
+ LispError.lispAssert(aNewFunction != null, aEnvironment, aStackTop);
+ LispError.check(aEnvironment, aStackTop, !((SingleArityRulebase) iFunctions.get(ruleIndex)).isArity(aNewFunction.arity()), LispError.ARITY_ALREADY_DEFINED, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, !aNewFunction.isArity(((SingleArityRulebase) iFunctions.get(ruleIndex)).arity()), LispError.ARITY_ALREADY_DEFINED, "INTERNAL");
+ }
+ iFunctions.add(aNewFunction);
+ }//end method.
+
+
+ /**
+ *Delete user function with given arity. If arity is -1 then delete all functions regardless of arity.
+ */
+ public void deleteRulebaseEntry(int aArity, int aStackTop, Environment aEnvironment) throws Exception {
+ if (aArity == -1) //Retract all functions regardless of arity.
+ {
+ iFunctions.clear();
+ return;
+ }//end if.
+
+ int ruleIndex;
+ //Find function body with the right arity
+ int numberOfRules = iFunctions.size();
+ for (ruleIndex = 0; ruleIndex < numberOfRules; ruleIndex++) {
+ LispError.lispAssert(((SingleArityRulebase) iFunctions.get(ruleIndex)) != null, aEnvironment, aStackTop);
+
+ if (((SingleArityRulebase) iFunctions.get(ruleIndex)).isArity(aArity)) {
+ iFunctions.remove(ruleIndex);
+ return;
+ }
+ }
+ }//end method.
+
+
+ public Iterator getFunctions() {
+ return this.iFunctions.iterator();
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ParameterName.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ParameterName.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/ParameterName.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/ParameterName.java 2010-07-18 16:36:18.000000000 +0000
@@ -0,0 +1,44 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+/**
+ * Contains the name of a parameter and if it is put on hold.
+ */
+public class ParameterName
+{
+ String iName;
+ boolean iHold;
+
+ public ParameterName(String aParameter, boolean aHold /*=false*/)
+ {
+ iName = aParameter;
+ iHold = aHold;
+ }
+
+ public String getName()
+ {
+ return iName;
+ }
+
+ public boolean isHold()
+ {
+ return iHold;
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/PatternRule.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/PatternRule.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/PatternRule.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/PatternRule.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,80 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.builtin.BuiltinContainer;
+import org.mathpiper.builtin.PatternContainer;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.parametermatchers.ParametersPatternMatcher;
+
+/**
+ * A rule which matches if the corresponding {@link PatternContainer} matches.
+ */
+public class PatternRule extends Rule {
+
+ protected int iPrecedence;
+ protected ConsPointer iBody;
+ protected ConsPointer iPredicate;
+ protected PatternContainer iPattern; //The pattern that decides whether this rule matches or not.
+
+ /**
+ *
+ * @param aPrecedence precedence of the rule
+ * @param aPredicate getObject object of type PatternContainer
+ * @param aBody body of the rule
+ */
+ public PatternRule(Environment aEnvironment, int aStackTop, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
+ iBody = new ConsPointer();
+ iPredicate = new ConsPointer();
+ iPattern = null;
+ iPrecedence = aPrecedence;
+ iPredicate.setCons(aPredicate.getCons());
+
+ BuiltinContainer gen = (BuiltinContainer) aPredicate.car();
+ LispError.check(aEnvironment, aStackTop, gen != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, gen.typeName().equals("\"Pattern\""), LispError.INVALID_ARGUMENT, "INTERNAL");
+
+ iPattern = (PatternContainer) gen;
+ iBody.setCons(aBody.getCons());
+ }
+
+ //Return true if the corresponding pattern matches.
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception {
+ return iPattern.matches(aEnvironment, aStackTop, aArguments);
+ }
+
+ //Access iPrecedence.
+ public int getPrecedence() {
+ return iPrecedence;
+ }
+
+ public ConsPointer getPredicatePointer() {
+ return this.iPredicate;
+ }
+
+ public ParametersPatternMatcher getPattern() {
+ return iPattern.getPattern();
+ }
+
+ //Access iBody
+ public ConsPointer getBodyPointer() {
+ return iBody;
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/PredicateRule.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/PredicateRule.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/PredicateRule.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/PredicateRule.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,86 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.Utility;
+
+/**
+ * A rule with a predicate (the rule matches if the predicate evaluates to True.)
+ */
+class PredicateRule extends Rule {
+
+ protected int iPrecedence;
+ protected ConsPointer iBody;
+ protected ConsPointer iPredicate;
+
+
+ public PredicateRule(Environment aEnvironment, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) {
+ iBody = new ConsPointer();
+ iBody.setCons(aBody.getCons());
+ iPredicate = new ConsPointer();
+ iPrecedence = aPrecedence;
+ iPredicate.setCons(aPredicate.getCons());
+
+ }
+
+
+ protected PredicateRule(Environment aEnvironment) {
+ iBody = new ConsPointer();
+ iPredicate = new ConsPointer();
+ }
+
+
+ private PredicateRule() {
+ }
+
+
+ /**
+ * Return true if the rule matches.
+ *
+ * @param aEnvironment
+ * @param aArguments
+ * @return
+ * @throws java.lang.Exception
+ */
+ // iPredicate is evaluated in \a Environment. If the result
+ /// IsTrue(), this function returns true
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception {
+ ConsPointer pred = new ConsPointer();
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, pred, iPredicate);
+ return Utility.isTrue(aEnvironment, pred, aStackTop);
+ }
+
+ /// Access #iPrecedence.
+
+ public int getPrecedence() {
+ return iPrecedence;
+ }
+
+ /// Access #iBody.
+
+ public ConsPointer getBodyPointer() {
+ return iBody;
+ }
+
+
+ public ConsPointer getPredicatePointer() {
+ return this.iPredicate;
+ }
+
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/Rule.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/Rule.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/Rule.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/Rule.java 2010-07-18 16:36:18.000000000 +0000
@@ -0,0 +1,36 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+
+/**
+ * Base class for rules.
+ */
+public abstract class Rule
+{
+
+ public abstract boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception;
+
+ public abstract int getPrecedence();
+
+ public abstract ConsPointer getPredicatePointer();
+
+ public abstract ConsPointer getBodyPointer();
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/SingleArityRulebase.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/SingleArityRulebase.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/SingleArityRulebase.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/SingleArityRulebase.java 2011-02-02 08:39:53.000000000 +0000
@@ -0,0 +1,496 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.stacks.UserStackInformation;
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.LispError;
+import org.mathpiper.lisp.Environment;
+import org.mathpiper.lisp.cons.SublistCons;
+import java.util.*;
+import org.mathpiper.builtin.BuiltinFunction;
+import org.mathpiper.exceptions.EvaluationException;
+import org.mathpiper.exceptions.ReturnException;
+import org.mathpiper.lisp.Evaluator;
+
+/**
+ * A function (usually mathematical) which is defined by one or more rules.
+ * This is the basic class which implements functions. Evaluation is done
+ * by consulting a set of rewritng rules. The body of the first rule that
+ * matches is evaluated and its result is returned as the function's result.
+ */
+public class SingleArityRulebase extends Evaluator {
+ // List of arguments, with corresponding iHold property.
+ protected List iParameters = new ArrayList(); //CArrayGrower
+
+ // List of rules, sorted on precedence.
+ protected List iBranchRules = new ArrayList();//CDeletingArrayGrower
+
+ // List of arguments
+ ConsPointer iParameterList;
+/// Abstract class providing the basic user function API.
+/// Instances of this class are associated to the name of the function
+/// via an associated hash table. When obtained, they can be used to
+/// evaluate the function with some arguments.
+ boolean iFenced = true;
+ boolean showFlag = false;
+ protected String functionType = "**** user rulebase";
+ protected String functionName;
+ protected Environment iEnvironment;
+
+
+ /**
+ * Constructor.
+ *
+ * @param aParameters linked list constaining the names of the arguments
+ * @throws java.lang.Exception
+ */
+ public SingleArityRulebase(Environment aEnvironment, int aStackTop, ConsPointer aParametersPointer, String functionName) throws Exception {
+ iEnvironment = aEnvironment;
+ this.functionName = functionName;
+ iParameterList = new ConsPointer();
+ // iParameterList and #iParameters are set from \a aParameters.
+ iParameterList.setCons(aParametersPointer.getCons());
+
+ ConsPointer parameterPointer = new ConsPointer(aParametersPointer.getCons());
+
+ while (parameterPointer.getCons() != null) {
+
+ try {
+ LispError.check(aEnvironment, aStackTop, parameterPointer.car() instanceof String, LispError.CREATING_USER_FUNCTION, "INTERNAL");
+ } catch (EvaluationException ex) {
+ if (ex.getFunctionName() == null) {
+ throw new EvaluationException(ex.getMessage() + " In function: " + this.functionName + ", ", "none", -1, this.functionName);
+ } else {
+ throw ex;
+ }
+ }//end catch.
+
+ ParameterName parameter = new ParameterName((String) parameterPointer.car(), false);
+ iParameters.add(parameter);
+ parameterPointer.goNext(aStackTop, aEnvironment);
+ }
+ }
+
+
+ /**
+ * Evaluate the function with the given arguments.
+ * First, all arguments are evaluated by the evaluator associated
+ * with aEnvironment, unless the iHold flag of the
+ * corresponding parameter is true. Then a new LocalFrame is
+ * constructed, in which the actual arguments are assigned to the
+ * names of the formal arguments, as stored in iName. Then
+ * all rules in iRules are tried one by one. The body of the
+ * first rule that matches is evaluated, and the result is put in
+ * aResult. If no rule matches, aResult will recieve a new
+ * expression with evaluated arguments.
+ *
+ * @param aResult (on output) the result of the evaluation
+ * @param aEnvironment the underlying Lisp environment
+ * @param aArguments the arguments to the function
+ * @throws java.lang.Exception
+ */
+ public void evaluate(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArgumentsPointer) throws Exception {
+ int arity = arity();
+ ConsPointer[] argumentsResultPointerArray = evaluateArguments(aEnvironment, aStackTop, aArgumentsPointer);
+
+ // Create a new local variables frame that has the same fenced state as this function.
+ aEnvironment.pushLocalFrame(fenced(), this.functionName);
+
+ int beforeStackTop = -1;
+ int beforeEvaluationDepth = -1;
+ int originalStackTop = -1;
+
+ try {
+
+ // define the local variables.
+ for (int parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
+ String variableName = ((ParameterName) iParameters.get(parameterIndex)).iName;
+ // set the variable to the new value
+ aEnvironment.newLocalVariable(variableName, argumentsResultPointerArray[parameterIndex].getCons(), aStackTop);
+ }
+
+ // walk the rules database, returning the evaluated result if the
+ // predicate is true.
+ int numberOfRules = iBranchRules.size();
+
+ UserStackInformation userStackInformation = aEnvironment.iLispExpressionEvaluator.stackInformation();
+
+ for (int ruleIndex = 0; ruleIndex < numberOfRules; ruleIndex++) {
+ Rule thisRule = ((Rule) iBranchRules.get(ruleIndex));
+ LispError.lispAssert(thisRule != null, aEnvironment, aStackTop);
+
+ userStackInformation.iRulePrecedence = thisRule.getPrecedence();
+
+ boolean matches = thisRule.matches(aEnvironment, aStackTop, argumentsResultPointerArray);
+
+ if (matches) {
+
+ /* Rule dump trace code. */
+ if (isTraced() && showFlag) {
+ ConsPointer argumentsPointer = new ConsPointer();
+ argumentsPointer.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String ruleDump = org.mathpiper.lisp.Utility.dumpRule(aStackTop, thisRule, aEnvironment, this);
+ Evaluator.traceShowRule(aEnvironment, argumentsPointer, ruleDump);
+ }
+
+ userStackInformation.iSide = 1;
+
+ try {
+ beforeStackTop = aEnvironment.iArgumentStack.getStackTopIndex();
+ beforeEvaluationDepth = aEnvironment.iEvalDepth;
+
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, aResult, thisRule.getBodyPointer()); //*** User function is called here.
+
+ } catch (ReturnException re) {
+ //todo:tk:note that user functions currently return their results in aResult, not on the stack.
+ int stackTopIndex = aEnvironment.iArgumentStack.getStackTopIndex();
+ ConsPointer resultPointer = BuiltinFunction.getTopOfStackPointer(aEnvironment, stackTopIndex - 1);
+
+ aResult.setCons(resultPointer.getCons());
+
+ aEnvironment.iArgumentStack.popTo(beforeStackTop, aStackTop, aEnvironment);
+ aEnvironment.iEvalDepth = beforeEvaluationDepth;
+
+ }
+
+ /*Leave trace code */
+ if (isTraced() && showFlag) {
+ ConsPointer argumentsPointer2 = new ConsPointer();
+ argumentsPointer2.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String localVariables = aEnvironment.getLocalVariables(aStackTop);
+ Evaluator.traceShowLeave(aEnvironment, aResult, argumentsPointer2, functionType, localVariables);
+ argumentsPointer2.setCons(null);
+ }//end if.
+
+ return;
+ }//end if matches.
+
+ // If rules got inserted, walk back.
+ while (thisRule != ((Rule) iBranchRules.get(ruleIndex)) && ruleIndex > 0) {
+ ruleIndex--;
+ }
+ }//end for.
+
+
+ // No predicate was true: return a new expression with the evaluated
+ // arguments.
+ ConsPointer full = new ConsPointer();
+ full.setCons(aArgumentsPointer.getCons().copy(aEnvironment, false));
+ if (arity == 0) {
+ full.cdr().setCons(null);
+ } else {
+ full.cdr().setCons(argumentsResultPointerArray[0].getCons());
+ for (int parameterIndex = 0; parameterIndex < arity - 1; parameterIndex++) {
+ argumentsResultPointerArray[parameterIndex].cdr().setCons(argumentsResultPointerArray[parameterIndex + 1].getCons());
+ }
+ }
+ aResult.setCons(SublistCons.getInstance(aEnvironment, full.getCons()));
+
+
+ /* Trace code */
+ if (isTraced() && showFlag) {
+ ConsPointer argumentsPointer3 = new ConsPointer();
+ argumentsPointer3.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String localVariables = aEnvironment.getLocalVariables(aStackTop);
+ Evaluator.traceShowLeave(aEnvironment, aResult, argumentsPointer3, functionType, localVariables);
+ argumentsPointer3.setCons(null);
+ }
+
+ } catch (EvaluationException ex) {
+
+ //ex.printStackTrace();//todo:tk:uncomment for debugging.
+
+ if (ex.getFunctionName() == null) {
+ throw new EvaluationException(ex.getMessage() + " In function: " + this.functionName + ", ", "none", -1, this.functionName);
+ } else {
+ throw ex;
+ }
+ } finally {
+ aEnvironment.popLocalFrame(aStackTop);
+ }
+ }
+
+
+ protected ConsPointer[] evaluateArguments(Environment aEnvironment, int aStackTop, ConsPointer aArgumentsPointer) throws Exception {
+ int arity = arity();
+ int parameterIndex;
+
+ /*Enter trace code*/
+ if (isTraced()) {
+ ConsPointer argumentsPointer = new ConsPointer();
+ argumentsPointer.setCons(SublistCons.getInstance(aEnvironment, aArgumentsPointer.getCons()));
+ String traceFunctionName = "";
+ if (argumentsPointer.car() instanceof ConsPointer) {
+ ConsPointer sub = (ConsPointer) argumentsPointer.car();
+ if (sub.car() instanceof String) {
+ traceFunctionName = (String) sub.car();
+ }
+ }//end function.
+ if (Evaluator.isTraceFunction(traceFunctionName)) {
+ showFlag = true;
+ Evaluator.traceShowEnter(aEnvironment, argumentsPointer, functionType);
+ } else {
+ showFlag = false;
+ }//
+ argumentsPointer.setCons(null);
+ }
+
+ ConsPointer argumentsTraverser = new ConsPointer(aArgumentsPointer.getCons());
+
+ //Strip the function name from the head of the list.
+ argumentsTraverser.goNext(aStackTop, aEnvironment);
+
+ //Creat an array which holds pointers to each argument.
+ ConsPointer[] argumentsResultPointerArray;
+ if (arity == 0) {
+ argumentsResultPointerArray = null;
+ } else {
+ LispError.lispAssert(arity > 0, aEnvironment, aStackTop);
+ argumentsResultPointerArray = new ConsPointer[arity];
+ }
+
+ // Walk over all arguments, evaluating them as necessary ********************************************************
+ for (parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
+
+ argumentsResultPointerArray[parameterIndex] = new ConsPointer();
+
+ LispError.check(aEnvironment, aStackTop, argumentsTraverser.getCons() != null, LispError.WRONG_NUMBER_OF_ARGUMENTS, "INTERNAL");
+
+ if (((ParameterName) iParameters.get(parameterIndex)).iHold) {
+ //If the parameter is on hold, don't evaluate it and place a copy of it in argumentsPointerArray.
+ argumentsResultPointerArray[parameterIndex].setCons(argumentsTraverser.getCons().copy(aEnvironment, false));
+ } else {
+ //If the parameter is not on hold:
+
+ //Verify that the pointer to the arguments is not null.
+ LispError.check(aEnvironment, aStackTop, argumentsTraverser != null, LispError.WRONG_NUMBER_OF_ARGUMENTS, "INTERNAL");
+
+ //Evaluate each argument and place the result into argumentsResultPointerArray[i];
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, argumentsResultPointerArray[parameterIndex], argumentsTraverser);
+ }
+ argumentsTraverser.goNext(aStackTop, aEnvironment);
+ }//end for.
+
+ /*Argument trace code */
+ if (isTraced() && argumentsResultPointerArray != null && showFlag) {
+ //ConsTraverser consTraverser2 = new ConsTraverser(aArguments);
+ //ConsPointer traceArgumentPointer = new ConsPointer(aArgumentsPointer.getCons());
+
+ //ConsTransverser traceArgumentPointer new ConsTraverser(this.iParameterList);
+ ConsPointer traceParameterPointer = new ConsPointer(this.iParameterList.getCons());
+
+ //traceArgumentPointer.goNext();
+ for (parameterIndex = 0; parameterIndex < argumentsResultPointerArray.length; parameterIndex++) {
+ Evaluator.traceShowArg(aEnvironment, traceParameterPointer, argumentsResultPointerArray[parameterIndex]);
+
+ traceParameterPointer.goNext(aStackTop, aEnvironment);
+ }//end for.
+ }//end if.
+
+ return argumentsResultPointerArray;
+
+ }//end method.
+
+
+ /**
+ * Put an argument on hold.
+ * The \c iHold flag of the corresponding argument is setCons. This
+ * implies that this argument is not evaluated by evaluate().
+ *
+ * @param aVariable name of argument to put un hold
+ */
+ public void holdArgument(String aVariable) {
+ int i;
+ int nrc = iParameters.size();
+ for (i = 0; i < nrc; i++) {
+ if (((ParameterName) iParameters.get(i)).iName.equals(aVariable)) {
+ ((ParameterName) iParameters.get(i)).iHold = true;
+ }
+ }
+ }
+
+
+ /**
+ * Return true if the arity of the function equals \a aArity.
+ *
+ * @param aArity
+ * @return true of the arities match.
+ */
+ public boolean isArity(int aArity) {
+ return (arity() == aArity);
+ }
+
+
+ /**
+ * Return the arity (number of arguments) of the function.
+ *
+ * @return the arity of the function
+ */
+ public int arity() {
+ return iParameters.size();
+ }
+
+
+ /**
+ * Add a PredicateRule to the list of rules.
+ * See: insertRule()
+ *
+ * @param aPrecedence
+ * @param aPredicate
+ * @param aBody
+ * @throws java.lang.Exception
+ */
+ public void defineSometimesTrueRule(int aStackTop, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
+ // New branching rule.
+ PredicateRule newRule = new PredicateRule(iEnvironment, aPrecedence, aPredicate, aBody);
+ LispError.check(iEnvironment, aStackTop, newRule != null, LispError.CREATING_RULE, "INTERNAL");
+
+ insertRule(aPrecedence, newRule);
+ }
+
+
+ /**
+ * Add a TrueRule to the list of rules.
+ * See: insertRule()
+ *
+ * @param aPrecedence
+ * @param aBody
+ * @throws java.lang.Exception
+ */
+ public void defineAlwaysTrueRule(int aStackTop, int aPrecedence, ConsPointer aBody) throws Exception {
+ // New branching rule.
+ PredicateRule newRule = new TrueRule(iEnvironment, aPrecedence, aBody);
+ LispError.check(iEnvironment, aStackTop, newRule != null, LispError.CREATING_RULE, "INTERNAL");
+
+ insertRule(aPrecedence, newRule);
+ }
+
+
+ /**
+ * Add a PatternRule to the list of rules.
+ * See: insertRule()
+ *
+ * @param aPrecedence
+ * @param aPredicate
+ * @param aBody
+ * @throws java.lang.Exception
+ */
+ public void definePattern(int aStackTop, int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
+ // New branching rule.
+ PatternRule newRule = new PatternRule(iEnvironment, aStackTop, aPrecedence, aPredicate, aBody);
+ LispError.check(iEnvironment, aStackTop, newRule != null, LispError.CREATING_RULE, "INTERNAL");
+
+ insertRule(aPrecedence, newRule);
+ }
+
+
+ /**
+ * Insert any Rule object in the list of rules.
+ * This function does the real work for defineAlwaysTrueRule() and
+ * definePattern(): it inserts the rule in iRules, while
+ * keeping it sorted. The algorithm is O(log n), where
+ * n denotes the number of rules.
+ *
+ * @param aPrecedence
+ * @param newRule
+ */
+ void insertRule(int aNewRulePrecedence, Rule aNewRule) {
+ // Find place to insert
+ int low, high, mid;
+ low = 0;
+ high = iBranchRules.size();
+
+ // Constant time: find out if the precedence is before any of the
+ // currently defined rules or past them.
+ if (high > 0) {
+ if (((Rule) iBranchRules.get(0)).getPrecedence() > aNewRulePrecedence) {
+ mid = 0;
+ // Insert it
+ iBranchRules.add(mid, aNewRule);
+ return;
+ }
+ if (((Rule) iBranchRules.get(high - 1)).getPrecedence() < aNewRulePrecedence) {
+ mid = high;
+ // Insert it
+ iBranchRules.add(mid, aNewRule);
+ return;
+ }
+ }
+
+ // Otherwise, O(log n) search algorithm for place to insert
+ while(true) {
+ if (low >= high) {
+ //Insert it.
+ mid = low;
+ iBranchRules.add(mid, aNewRule);
+ return;
+ }
+
+
+ mid = (low + high) >> 1;
+
+ Rule existingRule = (Rule) iBranchRules.get(mid);
+
+ int existingRulePrecedence = existingRule.getPrecedence();
+
+ if (existingRulePrecedence > aNewRulePrecedence) {
+ high = mid;
+ } else if (existingRulePrecedence < aNewRulePrecedence) {
+ low = (++mid);
+ } else {
+
+ //existingRule.
+ //Insert it.
+ iBranchRules.add(mid, aNewRule);
+ return;
+ }
+ }
+ }
+
+
+ /**
+ * Return the argument list, stored in #iParameterList.
+ *
+ * @return a ConsPointer
+ */
+ public ConsPointer argList() {
+ return iParameterList;
+ }
+
+
+ public Iterator getRules() {
+ return iBranchRules.iterator();
+ }
+
+
+ public Iterator getParameters() {
+ return iParameters.iterator();
+ }
+
+
+ public void unFence() {
+ iFenced = false;
+ }
+
+
+ public boolean fenced() {
+ return iFenced;
+ }
+
+}//end class.
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/TrueRule.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/TrueRule.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/rulebases/TrueRule.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/rulebases/TrueRule.java 2010-12-29 04:07:15.000000000 +0000
@@ -0,0 +1,41 @@
+/* {{{ License.
+ * 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 2
+ * of the License, or 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, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ */ //}}}
+
+// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
+package org.mathpiper.lisp.rulebases;
+
+import org.mathpiper.lisp.cons.ConsPointer;
+import org.mathpiper.lisp.Environment;
+
+/**
+ * A rule that always matches.
+ */
+class TrueRule extends PredicateRule
+{
+
+ public TrueRule(Environment aEnvironment, int aPrecedence, ConsPointer aBody)
+ {
+ super(aEnvironment);
+ iPrecedence = aPrecedence;
+ iBody.setCons(aBody.getCons());
+ }
+ /// Return true, always.
+ @Override
+ public boolean matches(Environment aEnvironment, int aStackTop, ConsPointer[] aArguments) throws Exception
+ {
+ return true;
+ }
+}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/stacks/ArgumentStack.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/stacks/ArgumentStack.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/stacks/ArgumentStack.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/stacks/ArgumentStack.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,9 +13,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/ //}}}
-
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
package org.mathpiper.lisp.stacks;
import org.mathpiper.lisp.*;
@@ -27,97 +25,118 @@
* Implements a stack of pointers to CONS that can be used to pass
* arguments to functions, and receive results back.
*/
-public class ArgumentStack
-{
+public class ArgumentStack {
ConsPointerArray iArgumentStack;
int iStackTopIndex;
//TODO appropriate constructor?
- public ArgumentStack(int aStackSize)
- {
- iArgumentStack = new ConsPointerArray(aStackSize, null);
+ public ArgumentStack(Environment aEnvironment, int aStackSize) {
+ iArgumentStack = new ConsPointerArray(aEnvironment, aStackSize, null);
iStackTopIndex = 0;
- //printf("STACKSIZE %d\n",aStackSize);
+ //printf("STACKSIZE %d\n",aStackSize);
}
- public int getStackTopIndex()
- {
+ public int getStackTopIndex() {
return iStackTopIndex;
}
- public void raiseStackOverflowError() throws Exception
- {
- LispError.raiseError("Argument stack reached maximum. Please extend argument stack with --stack argument on the command line.");
+ public void raiseStackOverflowError(int aStackTop, Environment aEnvironment) throws Exception {
+ LispError.raiseError("Argument stack reached maximum. Please extend argument stack with --stack argument on the command line.", "[INTERNAL]", aStackTop, aEnvironment);
}
- public void pushArgumentOnStack(Cons aCons) throws Exception
- {
- if (iStackTopIndex >= iArgumentStack.size())
- {
- raiseStackOverflowError();
+ public void pushArgumentOnStack(Cons aCons, int aStackTop, Environment aEnvironment) throws Exception {
+ if (iStackTopIndex >= iArgumentStack.size()) {
+ raiseStackOverflowError(aStackTop, aEnvironment);
}
iArgumentStack.setElement(iStackTopIndex, aCons);
iStackTopIndex++;
}
- public void pushNulls(int aNr) throws Exception
- {
- if (iStackTopIndex + aNr > iArgumentStack.size())
- {
- raiseStackOverflowError();
+ public void pushNulls(int aNr, int aStackTop, Environment aEnvironment) throws Exception {
+ if (iStackTopIndex + aNr > iArgumentStack.size()) {
+ raiseStackOverflowError(aStackTop, aEnvironment);
}
iStackTopIndex += aNr;
}
- public ConsPointer getElement(int aPos) throws Exception
- {
- LispError.lispAssert(aPos >= 0 && aPos < iStackTopIndex);
+ public ConsPointer getElement(int aPos, int aStackTop, Environment aEnvironment) throws Exception {
+ LispError.lispAssert(aPos >= 0 && aPos < iStackTopIndex, aEnvironment, aStackTop);
return iArgumentStack.getElement(aPos);
}
- public void popTo(int aTop) throws Exception
- {
- LispError.lispAssert(aTop <= iStackTopIndex);
- while (iStackTopIndex > aTop)
- {
+ public void popTo(int aTop, int aStackTop, Environment aEnvironment) throws Exception {
+ LispError.lispAssert(aTop <= iStackTopIndex, aEnvironment, aStackTop);
+ while (iStackTopIndex > aTop) {
iStackTopIndex--;
iArgumentStack.setElement(iStackTopIndex, null);
}
}
-
- public void reset() throws Exception
- {
- this.popTo(0);
- }//end method.
-
- public void dump() throws Exception
- {
- for(int x=0; x <= iStackTopIndex; x++)
- {
- //try
- //{
- ConsPointer consPointer = getElement(x);
- Cons cons = consPointer.getCons();
- //}
- //catch(Exception e)
- //{
- // e.printStackTrace();
- //}
-
- //System.out.println()
- }
+ public void reset(int aStackTop, Environment aEnvironment) throws Exception {
+ this.popTo(0, aStackTop, aEnvironment);
}//end method.
+ public String dump(int aStackTop, Environment aEnvironment) throws Exception {
+
+ StringBuilder stringBuilder = new StringBuilder();
+
+ int functionBaseIndex = 0;
+
+ int functionPositionIndex = 0;
+
+
+ while (functionBaseIndex <= aStackTop) {
+
+ if(functionBaseIndex == 0)
+ {
+ stringBuilder.append("\n\n========================================= Start Of Built In Function Stack Trace\n");
+ }
+ else
+ {
+ stringBuilder.append("-----------------------------------------\n");
+ }
+
+ ConsPointer consPointer = getElement(functionBaseIndex, aStackTop, aEnvironment);
+
+ int argumentCount = Utility.listLength(aEnvironment, aStackTop, consPointer);
- public ConsPointer[] getElements(int quantity) throws IndexOutOfBoundsException
- {
+ ConsPointer argumentPointer = new ConsPointer();
+
+ Object car = consPointer.getCons().car();
+
+ ConsPointer consTraverser = new ConsPointer( consPointer.getCons());
+
+ stringBuilder.append(functionPositionIndex++ + ": ");
+ stringBuilder.append(Utility.printMathPiperExpression(aStackTop, consTraverser, aEnvironment, -1));
+ stringBuilder.append("\n");
+
+ consTraverser.goNext(aStackTop, aEnvironment);
+
+ while(consTraverser.getCons() != null)
+ {
+ stringBuilder.append(" " + functionPositionIndex++ + ": ");
+ stringBuilder.append("-> " + Utility.printMathPiperExpression(aStackTop, consTraverser, aEnvironment, -1));
+ stringBuilder.append("\n");
+
+ consTraverser.goNext(aStackTop, aEnvironment);
+ }
+
+
+ functionBaseIndex = functionBaseIndex + argumentCount;
+
+ }//end while.
+
+ stringBuilder.append("========================================= End Of Built In Function Stack Trace\n\n");
+
+ return stringBuilder.toString();
+
+ }//end method.
+
+ public ConsPointer[] getElements(int quantity) throws IndexOutOfBoundsException {
int last = iStackTopIndex;
int first = last - quantity;
return iArgumentStack.getElements(first, last);
}//end method.
-
-
-
}//end class.
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/stacks/UserStackInformation.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/stacks/UserStackInformation.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/stacks/UserStackInformation.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/stacks/UserStackInformation.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,24 +13,23 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.stacks;
import org.mathpiper.lisp.cons.ConsPointer;
-public class UserStackInformation
-{
+public class UserStackInformation {
+
+ public ConsPointer iExpression;
+ public ConsPointer iOperator;
+ public int iRulePrecedence;
+ public int iSide; // 0=pattern, 1=body
+
+
+ public UserStackInformation() {
+ iRulePrecedence = -1;
+ iSide = 0;
+ }
- public ConsPointer iExpression;
- public ConsPointer iOperator;
- public int iRulePrecedence;
- public int iSide; // 0=pattern, 1=body
-
- public UserStackInformation()
- {
- iRulePrecedence = -1;
- iSide = 0;
- }
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/CommonLispTokenizer.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/CommonLispTokenizer.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/CommonLispTokenizer.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/CommonLispTokenizer.java 2010-12-29 04:07:15.000000000 +0000
@@ -17,123 +17,6 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.tokenizers;
-import org.mathpiper.lisp.collections.TokenMap;
-import org.mathpiper.io.MathPiperInputStream;
-
-/**
- *
- *
- */
-/*
-Running MathPiper from Eclipse IDE
-From: Axel - 2005-08-14 09:56
-
-
-
-
-Hi
-
-I"ve a little project which is similar to the piper applet:
-http://www.matheclipse.org
-which uses a JavaScript interface and a Java servlet backend.
-
-So I would like to test the piper applet from sources inside the
-http://www.eclipse.org IDE and checked out JavaMathPiper from CVS and get the
-following compile errors:
-
-Severity Description Resource In Folder Location Creation Time
-2 Syntax error on token "goto", throw
-expected CommonLispTokenizer.java JavaMathPiper line 14 14. August 2005
-18:43:21
-2 Syntax error on token "goto", break
-expected CommonLispTokenizer.java JavaMathPiper line 47 14. August 2005
-18:43:21
-2 Syntax error on token "goto", throw
-expected CommonLispTokenizer.java JavaMathPiper line 49 14. August 2005
-18:43:21
-2 Syntax error on token "goto", break
-expected CommonLispTokenizer.java JavaMathPiper line 54 14. August 2005
-18:43:21
-2 Syntax error on token "goto", throw
-expected CommonLispTokenizer.java JavaMathPiper line 113 14. August 2005
-18:43:21
-2 Syntax error on token "&", delete this
-token CommonLispTokenizer.java JavaMathPiper line 117 14. August 2005
-18:43:21
-2 CVersion cannot be resolved ConsoleApplet.java JavaMathPiper line
-123 14. August 2005 18:43:21
-2 CVersion cannot be resolved MathCommands.java JavaMathPiper line
-4194 14. August 2005 18:43:20
-2 CVersion cannot be resolved MathPiperConsole.java JavaMathPiper line 134 14.
-August 2005 18:43:18
-2 The method AddLine(String) in the type HintWindow is not applicable
-for the arguments (String,
-MathPiperGraphicsContext) MathPiperNotebook.java JavaMathPiper line 36 14. August
-2005 18:43:18
-2 The method AddLine(String) in the type HintWindow is not applicable
-for the arguments (String,
-MathPiperGraphicsContext) MathPiperNotebook.java JavaMathPiper line 37 14. August
-2005 18:43:18
-2 The method AddDescription(String) in the type HintWindow is not
-applicable for the arguments (String,
-MathPiperGraphicsContext) MathPiperNotebook.java JavaMathPiper line 38 14. August
-2005 18:43:18
-2 The method AddDescription(String) in the type HintWindow is not
-applicable for the arguments (String,
-MathPiperGraphicsContext) MathPiperNotebook.java JavaMathPiper line 39 14. August
-2005 18:43:18
-
-BTW:
- * all *.java files don"t contain a package declaration, which is
-really unusual in Java, by convention you can use something like:
-"package net.sourceforge.piper;"
- * also by convention in most projects java source files a stored below
-a subfolder "/src".
- * I attached the eclipse .project and .classpath I"ve used for the test.
-
---
-Axel Kramer
-
-
-
-
-
-Re: Running MathPiper from Eclipse IDE
-From: Ayal Pinkus - 2005-08-14 11:32
-
-Hi Axel,
-matheclipse looks interesting!
-
-For now I think you can leave out compiling CommonLispTokenizer.java.
-
-CVersion.java is generated by the make file makefile.piper. The
-contents are
-currently:
-
-class CVersion { static String VERSION = "1.0.58"; }
-
-For now you can skip compiling MathPiperNotebook.java too. Regarding
-package,
-that is something some one else mentioned too. I am not a very
-experienced
-Java programmer, as you might be able to tell.
-
-I will fix these things as soon as possible. In the mean time, I"ll
-forward an email I
-got from some one who is trying to use it in a way that might be
-similar to how you
-want to use it. He made changes that made it work for him. That might
-be of interest
-to you.
-
-Ayal
-
-
-
-*/
-
-import org.mathpiper.lisp.*;
-
class CommonLispTokenizer extends MathPiperTokenizer
{
/*
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/MathPiperTokenizer.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/MathPiperTokenizer.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/MathPiperTokenizer.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/MathPiperTokenizer.java 2010-12-29 04:07:15.000000000 +0000
@@ -25,13 +25,13 @@
public class MathPiperTokenizer {
- static String symbolics = new String("~`!@#$^&*-=+:<>?/\\|");
+ static String symbolics = "~`!@#$^&*-=+:<>?/\\|";
//static String unicodeVariableChars = "αβγ";
String iToken; //Can be used as a token container.
/// NextToken returns a string representing the next token,
/// or an empty list.
- public String nextToken(MathPiperInputStream aInput, TokenMap aTokenHashTable) throws Exception {
+ public String nextToken(Environment aEnvironment, int aStackTop, MathPiperInputStream aInput, TokenMap aTokenHashTable) throws Exception {
char streamCharacter;
int firstpos = aInput.position();
@@ -69,7 +69,7 @@
aInput.next(); //consume *
while (true) {
while (aInput.next() != '*' && !aInput.endOfStream());
- LispError.check(!aInput.endOfStream(), LispError.COMMENT_TO_END_OF_FILE);
+ LispError.check(aEnvironment, aStackTop, !aInput.endOfStream(), LispError.COMMENT_TO_END_OF_FILE, "INTERNAL");
if (aInput.peek() == '/') {
aInput.next(); // consume /
redo = true;
@@ -93,11 +93,17 @@
while (aInput.peek() != '\"') {
if (aInput.peek() == '\\') {
aInput.next();
- LispError.check(!aInput.endOfStream(), LispError.PARSING_INPUT);
+ LispError.check(aEnvironment, aStackTop, !aInput.endOfStream(), LispError.PARSING_INPUT, "INTERNAL");
+
+ /*if(! (aInput.peek() == '\"'))
+ {
+ //Leave in backslash in front of all characters except a " character.
+ aResult = aResult + "\\";
+ }*/
}
//TODO FIXME is following append char correct?
aResult = aResult + ((char) aInput.next());
- LispError.check(!aInput.endOfStream(), LispError.PARSING_INPUT);
+ LispError.check(aEnvironment, aStackTop, !aInput.endOfStream(), LispError.PARSING_INPUT, "INTERNAL");
}
//TODO FIXME is following append char correct?
aResult = aResult + ((char) aInput.next()); // consume the close quote
@@ -159,7 +165,9 @@
return true;
} else if (c == '\'') {
return true;
- } else if (c == 0x00b7) { // middle dot (for Catalan).
+ } else if (c == '?') {
+ return true;
+ }else if (c == 0x00b7) { // middle dot (for Catalan).
return true;
} else if (c == 0x00b0) { // degree symbol).
return true;
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/XmlTokenizer.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/XmlTokenizer.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/tokenizers/XmlTokenizer.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/tokenizers/XmlTokenizer.java 2010-12-29 04:07:15.000000000 +0000
@@ -13,75 +13,69 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*/
-
//}}}
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp.tokenizers;
import org.mathpiper.lisp.collections.TokenMap;
import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.tokenizers.MathPiperTokenizer;
import org.mathpiper.io.MathPiperInputStream;
+import org.mathpiper.lisp.Environment;
public class XmlTokenizer
- extends MathPiperTokenizer
-{
+ extends MathPiperTokenizer {
+
+ /// NextToken returns a string representing the next token,
+ /// or an empty list.
+ @Override
+ public String nextToken(Environment aEnvironment, int aStackTop, MathPiperInputStream aInput, TokenMap aHashTable)
+ throws Exception {
+
+ char c;
+ int firstpos = 0;
+
+ if (aInput.endOfStream()) {
+ return (String) aHashTable.lookUp(aInput.startPtr().substring(firstpos, aInput.position()));
+ }
+
+ //skipping spaces
+ while (IsSpace(aInput.peek())) {
+ aInput.next();
+ }
+
+ firstpos = aInput.position();
+ c = aInput.next();
+
+ if (c == '<') {
+
+ while (c != '>') {
+ c = aInput.next();
+ LispError.check(aEnvironment, aStackTop, !aInput.endOfStream(), LispError.COMMENT_TO_END_OF_FILE, "INTERNAL");
+ }
+ } else {
+
+ while (aInput.peek() != '<' && !aInput.endOfStream()) {
+ c = aInput.next();
+ }
+ }
+
+ return (String) aHashTable.lookUp(aInput.startPtr().substring(firstpos, aInput.position()));
+ }
+
+
+ private static boolean IsSpace(int c) {
+
+ switch (c) {
+
+ case 0x20:
+ case 0x0D:
+ case 0x0A:
+ case 0x09:
+ return true;
+
+ default:
+ return false;
+ }
+ }
- /// NextToken returns a string representing the next token,
- /// or an empty list.
- public String nextToken(MathPiperInputStream aInput, TokenMap aHashTable)
- throws Exception
- {
-
- char c;
- int firstpos = 0;
-
- if (aInput.endOfStream())
-
- return (String) aHashTable.lookUp(aInput.startPtr().substring(firstpos, aInput.position()));
-
- //skipping spaces
- while (IsSpace(aInput.peek()))
- aInput.next();
-
- firstpos = aInput.position();
- c = aInput.next();
-
- if (c == '<')
- {
-
- while (c != '>')
- {
- c = aInput.next();
- LispError.check(!aInput.endOfStream(), LispError.COMMENT_TO_END_OF_FILE);
- }
- }
- else
- {
-
- while (aInput.peek() != '<' && !aInput.endOfStream())
- {
- c = aInput.next();
- }
- }
-
- return (String) aHashTable.lookUp(aInput.startPtr().substring(firstpos, aInput.position()));
- }
-
- private static boolean IsSpace(int c)
- {
-
- switch (c)
- {
-
- case 0x20:
- case 0x0D:
- case 0x0A:
- case 0x09:
- return true;
-
- default:
- return false;
- }
- }
}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/Branch.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/Branch.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/Branch.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/Branch.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.userfunctions;
-
-import java.util.Iterator;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
-
-/**
- * Base class for rules.
- */
-public abstract class Branch
-{
-
- public abstract boolean matches(Environment aEnvironment, ConsPointer[] aArguments) throws Exception;
-
- public abstract int getPrecedence();
-
- public abstract ConsPointer getPredicatePointer();
-
- public abstract ConsPointer getBodyPointer();
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/FunctionParameter.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/FunctionParameter.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/FunctionParameter.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/FunctionParameter.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.userfunctions;
-
-/**
- * Contains the name of a parameter and if it is put on hold.
- */
-public class FunctionParameter
-{
- String iParameter;
- boolean iHold;
-
- public FunctionParameter(String aParameter, boolean aHold /*=false*/)
- {
- iParameter = aParameter;
- iHold = aHold;
- }
-
- public String getParameter()
- {
- return iParameter;
- }
-
- public boolean isHold()
- {
- return iHold;
- }
-
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/ListedBranchingUserFunction.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/ListedBranchingUserFunction.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/ListedBranchingUserFunction.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/ListedBranchingUserFunction.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,73 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.userfunctions;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.cons.ConsTraverser;
-import org.mathpiper.lisp.Environment;
-import org.mathpiper.lisp.cons.SublistCons;
-
-
-public class ListedBranchingUserFunction extends SingleArityBranchingUserFunction
-{
- public ListedBranchingUserFunction(ConsPointer aParameters, String functionName) throws Exception
- {
- super(aParameters, functionName);
- }
-
- public boolean isArity(int aArity)
- {
- return (arity() <= aArity);
- }
-
- public void evaluate( Environment aEnvironment,ConsPointer aResult, ConsPointer aArguments) throws Exception
- {
- ConsPointer newArgs = new ConsPointer();
- ConsTraverser consTraverser = new ConsTraverser(aArguments);
- ConsPointer ptr = newArgs;
- int arity = arity();
- int i=0;
- while (i < arity && consTraverser.getCons() != null)
- {
- ptr.setCons(consTraverser.getCons().copy( aEnvironment, false));
- ptr = (ptr.cdr());
- i++;
- consTraverser.goNext();
- }
- if (consTraverser.cdr().getCons() == null)
- {
- ptr.setCons(consTraverser.getCons().copy( aEnvironment, false));
- ptr = (ptr.cdr());
- i++;
- consTraverser.goNext();
- LispError.lispAssert(consTraverser.getCons() == null);
- }
- else
- {
- ConsPointer head = new ConsPointer();
- head.setCons(aEnvironment.iListAtom.copy( aEnvironment, false));
- head.cdr().setCons(consTraverser.getCons());
- ptr.setCons(SublistCons.getInstance(aEnvironment,head.getCons()));
- }
- super.evaluate(aEnvironment, aResult, newArgs);
- }
-}
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/ListedMacroUserFunction.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/ListedMacroUserFunction.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/ListedMacroUserFunction.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/ListedMacroUserFunction.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,73 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.userfunctions;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.cons.ConsTraverser;
-import org.mathpiper.lisp.Environment;
-import org.mathpiper.lisp.cons.SublistCons;
-
-
-public class ListedMacroUserFunction extends MacroUserFunction
-{
-
- public ListedMacroUserFunction(ConsPointer aParameters, String functionName) throws Exception
- {
- super(aParameters, functionName);
- }
-
- public boolean isArity(int aArity)
- {
- return (arity() <= aArity);
- }
-
- public void evaluate( Environment aEnvironment,ConsPointer aResult, ConsPointer aArguments) throws Exception
- {
- ConsPointer newArgs = new ConsPointer();
- ConsTraverser consTraverser = new ConsTraverser(aArguments);
- ConsPointer ptr = newArgs;
- int arity = arity();
- int i=0;
- while (i < arity && consTraverser.getCons() != null)
- {
- ptr.setCons(consTraverser.getCons().copy( aEnvironment, false));
- ptr = (ptr.cdr());
- i++;
- consTraverser.goNext();
- }
- if (consTraverser.cdr().getCons() == null)
- {
- ptr.setCons(consTraverser.getCons().copy( aEnvironment, false));
- ptr = (ptr.cdr());
- i++;
- consTraverser.goNext();
- LispError.lispAssert(consTraverser.getCons() == null);
- }
- else
- {
- ConsPointer head = new ConsPointer();
- head.setCons(aEnvironment.iListAtom.copy( aEnvironment, false));
- head.cdr().setCons(consTraverser.getCons());
- ptr.setCons(SublistCons.getInstance(aEnvironment,head.getCons()));
- }
- super.evaluate(aEnvironment, aResult, newArgs);
- }
-}
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/MacroUserFunction.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/MacroUserFunction.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/MacroUserFunction.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/MacroUserFunction.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,156 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.userfunctions;
-
-import org.mathpiper.exceptions.EvaluationException;
-import org.mathpiper.lisp.stacks.UserStackInformation;
-import org.mathpiper.lisp.behaviours.BackQuoteSubstitute;
-import org.mathpiper.lisp.Utility;
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.LispError;
-import org.mathpiper.lisp.cons.ConsTraverser;
-import org.mathpiper.lisp.Environment;
-import org.mathpiper.lisp.Evaluator;
-import org.mathpiper.lisp.LispExpressionEvaluator;
-import org.mathpiper.lisp.cons.SublistCons;
-
-public class MacroUserFunction extends SingleArityBranchingUserFunction {
-
- public MacroUserFunction(ConsPointer aParameters, String functionName) throws Exception {
- super(aParameters, functionName);
- ConsTraverser parameterTraverser = new ConsTraverser(aParameters);
- int i = 0;
- while (parameterTraverser.getCons() != null) {
-
- //LispError.check(parameterTraverser.car() != null, LispError.CREATING_USER_FUNCTION);
- try{
- LispError.check(parameterTraverser.car() instanceof String, LispError.CREATING_USER_FUNCTION);
- }catch(EvaluationException ex)
- {
- throw new EvaluationException(ex.getMessage() + " Function: " + this.functionName + " ",-1) ;
- }//end catch.
-
-
- ((FunctionParameter) iParameters.get(i)).iHold = true;
- parameterTraverser.goNext();
- i++;
- }
- //Macros are all unfenced.
- unFence();
-
- this.functionType = "macro";
- }
-
- public void evaluate(Environment aEnvironment, ConsPointer aResult, ConsPointer aArgumentsPointer) throws Exception {
- int arity = arity();
- ConsPointer[] argumentsResultPointerArray = evaluateArguments(aEnvironment, aArgumentsPointer);
- int parameterIndex;
-
-
-
- ConsPointer substitutedBodyPointer = new ConsPointer();
-
- //Create a new local variable frame that is unfenced (false = unfenced).
- aEnvironment.pushLocalFrame(false, this.functionName);
-
- try {
- // define the local variables.
- for (parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
- String variable = ((FunctionParameter) iParameters.get(parameterIndex)).iParameter;
-
- // setCons the variable to the new value
- aEnvironment.newLocalVariable(variable, argumentsResultPointerArray[parameterIndex].getCons());
- }
-
- // walk the rules database, returning the evaluated result if the
- // predicate is true.
- int numberOfRules = iBranchRules.size();
- UserStackInformation userStackInformation = aEnvironment.iLispExpressionEvaluator.stackInformation();
- for (parameterIndex = 0; parameterIndex < numberOfRules; parameterIndex++) {
- Branch thisRule = ((Branch) iBranchRules.get(parameterIndex));
- //TODO remove CHECKPTR(thisRule);
- LispError.lispAssert(thisRule != null);
-
- userStackInformation.iRulePrecedence = thisRule.getPrecedence();
-
- boolean matches = thisRule.matches(aEnvironment, argumentsResultPointerArray);
-
- if (matches) {
- /* Rule dump trace code. */
- if (isTraced() && showFlag) {
- ConsPointer argumentsPointer = new ConsPointer();
- argumentsPointer.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String ruleDump = org.mathpiper.lisp.Utility.dumpRule(thisRule, aEnvironment, this);
- Evaluator.traceShowRule(aEnvironment, argumentsPointer, ruleDump);
- }
- userStackInformation.iSide = 1;
-
- BackQuoteSubstitute backQuoteSubstitute = new BackQuoteSubstitute(aEnvironment);
-
- ConsPointer originalBodyPointer = thisRule.getBodyPointer();
- Utility.substitute(aEnvironment,substitutedBodyPointer, originalBodyPointer, backQuoteSubstitute);
- // aEnvironment.iLispExpressionEvaluator.Eval(aEnvironment, aResult, thisRule.body());
- break;
- }
-
- // If rules got inserted, walk back
- while (thisRule != ((Branch) iBranchRules.get(parameterIndex)) && parameterIndex > 0) {
- parameterIndex--;
- }
- }
- } catch (Exception e) {
- throw e;
- } finally {
- aEnvironment.popLocalFrame();
- }
-
-
-
- if (substitutedBodyPointer.getCons() != null) {
- //Note:tk:substituted body must be evaluated after the local frame has been popped.
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aResult, substitutedBodyPointer);
- } else // No predicate was true: return a new expression with the evaluated
- // arguments.
- {
- ConsPointer full = new ConsPointer();
- full.setCons(aArgumentsPointer.getCons().copy( aEnvironment, false));
- if (arity == 0) {
- full.cdr().setCons(null);
- } else {
- full.cdr().setCons(argumentsResultPointerArray[0].getCons());
- for (parameterIndex = 0; parameterIndex < arity - 1; parameterIndex++) {
- argumentsResultPointerArray[parameterIndex].cdr().setCons(argumentsResultPointerArray[parameterIndex + 1].getCons());
- }
- }
- aResult.setCons(SublistCons.getInstance(aEnvironment,full.getCons()));
- }
- //FINISH:
-
- /*Leave trace code */
- if (isTraced() && showFlag) {
- ConsPointer tr = new ConsPointer();
- tr.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String localVariables = aEnvironment.getLocalVariables();
- LispExpressionEvaluator.traceShowLeave(aEnvironment, aResult, tr, "macro", localVariables);
- tr.setCons(null);
- }
-
- }
-}
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/MultipleArityUserFunction.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/MultipleArityUserFunction.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/MultipleArityUserFunction.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/MultipleArityUserFunction.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,129 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-
-package org.mathpiper.lisp.userfunctions;
-
-
-import org.mathpiper.lisp.DefFile;
-import org.mathpiper.lisp.*;
-import java.util.*;
-
-
-
-/**
- * Holds a set of {@link SingleArityBranchingUserFunction} which are associated with one function name.
- * A specific SingleArityBranchingUserFunction can be selected by providing its name. The
- * name of the file in which the function is defined can also be specified.
- */
-public class MultipleArityUserFunction
-{
-
- /// Set of SingleArityBranchingUserFunction's provided by this MultipleArityUserFunction.
- List iFunctions = new ArrayList();//
-
- /// File to read for the definition of this function.
- public DefFile iFileToOpen;
-
- public String iFileLocation;
-
- /// Constructor.
- public MultipleArityUserFunction()
- {
- iFileToOpen = null;
- }
-
- /// Return user function with given arity.
- public SingleArityBranchingUserFunction getUserFunction(int aArity) throws Exception
- {
- int ruleIndex;
- //Find function body with the right arity
- int numberOfRules=iFunctions.size();
- for (ruleIndex =0; ruleIndex iParameters = new ArrayList(); //CArrayGrower
-
- /// List of rules, sorted on precedence.
- protected List iBranchRules = new ArrayList();//CDeletingArrayGrower
-
- /// List of arguments
- ConsPointer iParameterList = new ConsPointer();
-/// Abstract class providing the basic user function API.
-/// Instances of this class are associated to the name of the function
-/// via an associated hash table. When obtained, they can be used to
-/// evaluate the function with some arguments.
- boolean iFenced = true;
- boolean showFlag = false;
- protected String functionType = "**** user rulebase";
- protected String functionName;
-
- /**
- * Constructor.
- *
- * @param aParameters linked list constaining the names of the arguments
- * @throws java.lang.Exception
- */
- public SingleArityBranchingUserFunction(ConsPointer aParameters, String functionName) throws Exception {
- this.functionName = functionName;
- // iParameterList and #iParameters are set from \a aParameters.
- iParameterList.setCons(aParameters.getCons());
-
- ConsPointer parameterTraverser = new ConsPointer(aParameters.getCons());
-
- while (parameterTraverser.getCons() != null) {
-
- try{
- LispError.check(parameterTraverser.car() instanceof String, LispError.CREATING_USER_FUNCTION);
- }catch(EvaluationException ex)
- {
- throw new EvaluationException(ex.getMessage() + " Function: " + this.functionName + " ",-1) ;
- }//end catch.
-
- FunctionParameter parameter = new FunctionParameter( (String) parameterTraverser.car(), false);
- iParameters.add(parameter);
- parameterTraverser.goNext();
- }
- }
-
- /**
- * Evaluate the function with the given arguments.
- * First, all arguments are evaluated by the evaluator associated
- * with aEnvironment, unless the iHold flag of the
- * corresponding parameter is true. Then a new LocalFrame is
- * constructed, in which the actual arguments are assigned to the
- * names of the formal arguments, as stored in iParameter. Then
- * all rules in iRules are tried one by one. The body of the
- * getFirstPointer rule that matches is evaluated, and the result is put in
- * aResult. If no rule matches, aResult will recieve a new
- * expression with evaluated arguments.
- *
- * @param aResult (on output) the result of the evaluation
- * @param aEnvironment the underlying Lisp environment
- * @param aArguments the arguments to the function
- * @throws java.lang.Exception
- */
- public void evaluate(Environment aEnvironment, ConsPointer aResult, ConsPointer aArgumentsPointer) throws Exception {
- int arity = arity();
- ConsPointer[] argumentsResultPointerArray = evaluateArguments(aEnvironment, aArgumentsPointer);
- int parameterIndex;
-
- // Create a new local variables frame that has the same fenced state as this function.
- aEnvironment.pushLocalFrame(fenced(), this.functionName);
-
-
-
- try {
- // define the local variables.
- for (parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
- String variableName = ((FunctionParameter) iParameters.get(parameterIndex)).iParameter;
- // set the variable to the new value
- aEnvironment.newLocalVariable(variableName, argumentsResultPointerArray[parameterIndex].getCons());
- }
-
- // walk the rules database, returning the evaluated result if the
- // predicate is true.
- int numberOfRules = iBranchRules.size();
-
- UserStackInformation userStackInformation = aEnvironment.iLispExpressionEvaluator.stackInformation();
-
- for (parameterIndex = 0; parameterIndex < numberOfRules; parameterIndex++) {
- Branch thisRule = ((Branch) iBranchRules.get(parameterIndex));
- LispError.lispAssert(thisRule != null);
-
- userStackInformation.iRulePrecedence = thisRule.getPrecedence();
-
- boolean matches = thisRule.matches(aEnvironment, argumentsResultPointerArray);
-
- if (matches) {
-
- /* Rule dump trace code. */
- if (isTraced() && showFlag) {
- ConsPointer argumentsPointer = new ConsPointer();
- argumentsPointer.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String ruleDump = org.mathpiper.lisp.Utility.dumpRule(thisRule, aEnvironment, this);
- Evaluator.traceShowRule(aEnvironment, argumentsPointer, ruleDump);
- }
-
- userStackInformation.iSide = 1;
-
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aResult, thisRule.getBodyPointer());
-
- /*Leave trace code */
- if (isTraced() && showFlag) {
- ConsPointer argumentsPointer2 = new ConsPointer();
- argumentsPointer2.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String localVariables = aEnvironment.getLocalVariables();
- Evaluator.traceShowLeave(aEnvironment, aResult, argumentsPointer2, functionType, localVariables);
- argumentsPointer2.setCons(null);
- }//end if.
-
- return;
- }//end if matches.
-
- // If rules got inserted, walk back
- while (thisRule != ((Branch) iBranchRules.get(parameterIndex)) && parameterIndex > 0) {
- parameterIndex--;
- }
- }//end for.
-
-
- // No predicate was true: return a new expression with the evaluated
- // arguments.
- ConsPointer full = new ConsPointer();
- full.setCons(aArgumentsPointer.getCons().copy( aEnvironment, false));
- if (arity == 0) {
- full.cdr().setCons(null);
- } else {
- full.cdr().setCons(argumentsResultPointerArray[0].getCons());
- for (parameterIndex = 0; parameterIndex < arity - 1; parameterIndex++) {
- argumentsResultPointerArray[parameterIndex].cdr().setCons(argumentsResultPointerArray[parameterIndex + 1].getCons());
- }
- }
- aResult.setCons(SublistCons.getInstance(aEnvironment,full.getCons()));
-
-
- /* Trace code */
- if (isTraced() && showFlag) {
- ConsPointer argumentsPointer3 = new ConsPointer();
- argumentsPointer3.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String localVariables = aEnvironment.getLocalVariables();
- Evaluator.traceShowLeave(aEnvironment, aResult, argumentsPointer3, functionType, localVariables);
- argumentsPointer3.setCons(null);
- }
-
- } catch (Exception e) {
- throw e;
- } finally {
- aEnvironment.popLocalFrame();
- }
- }
-
- protected ConsPointer[] evaluateArguments(Environment aEnvironment, ConsPointer aArgumentsPointer) throws Exception {
- int arity = arity();
- int parameterIndex;
-
- /*Enter trace code*/
- if (isTraced()) {
- ConsPointer argumentsPointer = new ConsPointer();
- argumentsPointer.setCons(SublistCons.getInstance(aEnvironment,aArgumentsPointer.getCons()));
- String functionName = "";
- if (argumentsPointer.car() instanceof ConsPointer) {
- ConsPointer sub = (ConsPointer) argumentsPointer.car();
- if (sub.car() instanceof String) {
- functionName = (String) sub.car();
- }
- }//end function.
- if (Evaluator.isTraceFunction(functionName)) {
- showFlag = true;
- Evaluator.traceShowEnter(aEnvironment, argumentsPointer, functionType);
- } else {
- showFlag = false;
- }//
- argumentsPointer.setCons(null);
- }
-
- ConsPointer argumentsTraverser = new ConsPointer(aArgumentsPointer.getCons());
-
- //Strip the function name from the head of the list.
- argumentsTraverser.goNext();
-
- //Creat an array which holds pointers to each argument.
- ConsPointer[] argumentsResultPointerArray;
- if (arity == 0) {
- argumentsResultPointerArray = null;
- } else {
- LispError.lispAssert(arity > 0);
- argumentsResultPointerArray = new ConsPointer[arity];
- }
-
- // Walk over all arguments, evaluating them as necessary ********************************************************
- for (parameterIndex = 0; parameterIndex < arity; parameterIndex++) {
-
- argumentsResultPointerArray[parameterIndex] = new ConsPointer();
-
- LispError.check(argumentsTraverser.getCons() != null, LispError.WRONG_NUMBER_OF_ARGUMENTS);
-
- if (((FunctionParameter) iParameters.get(parameterIndex)).iHold) {
- //If the parameter is on hold, don't evaluate it and place a copy of it in argumentsPointerArray.
- argumentsResultPointerArray[parameterIndex].setCons(argumentsTraverser.getCons().copy( aEnvironment, false));
- } else {
- //If the parameter is not on hold:
-
- //Verify that the pointer to the arguments is not null.
- LispError.check(argumentsTraverser != null, LispError.WRONG_NUMBER_OF_ARGUMENTS);
-
- //Evaluate each argument and place the result into argumentsResultPointerArray[i];
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, argumentsResultPointerArray[parameterIndex], argumentsTraverser);
- }
- argumentsTraverser.goNext();
- }//end for.
-
- /*Argument trace code */
- if (isTraced() && argumentsResultPointerArray != null && showFlag) {
- //ConsTraverser consTraverser2 = new ConsTraverser(aArguments);
- //ConsPointer traceArgumentPointer = new ConsPointer(aArgumentsPointer.getCons());
-
- //ConsTransverser traceArgumentPointer new ConsTraverser(this.iParameterList);
- ConsPointer traceParameterPointer = new ConsPointer(this.iParameterList.getCons());
-
- //traceArgumentPointer.goNext();
- for (parameterIndex = 0; parameterIndex < argumentsResultPointerArray.length; parameterIndex++) {
- Evaluator.traceShowArg(aEnvironment, traceParameterPointer, argumentsResultPointerArray[parameterIndex]);
-
- traceParameterPointer.goNext();
- }//end for.
- }//end if.
-
- return argumentsResultPointerArray;
-
- }//end method.
-
- /**
- * Put an argument on hold.
- * The \c iHold flag of the corresponding argument is setCons. This
- * implies that this argument is not evaluated by evaluate().
- *
- * @param aVariable name of argument to put un hold
- */
- public void holdArgument(String aVariable) {
- int i;
- int nrc = iParameters.size();
- for (i = 0; i < nrc; i++) {
- if (((FunctionParameter) iParameters.get(i)).iParameter == aVariable) {
- ((FunctionParameter) iParameters.get(i)).iHold = true;
- }
- }
- }
-
- /**
- * Return true if the arity of the function equals \a aArity.
- *
- * @param aArity
- * @return true of the arities match.
- */
- public boolean isArity(int aArity) {
- return (arity() == aArity);
- }
-
- /**
- * Return the arity (number of arguments) of the function.
- *
- * @return the arity of the function
- */
- public int arity() {
- return iParameters.size();
- }
-
- /**
- * Add a RuleBranch to the list of rules.
- * See: insertRule()
- *
- * @param aPrecedence
- * @param aPredicate
- * @param aBody
- * @throws java.lang.Exception
- */
- public void declareRule(int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
- // New branching rule.
- RuleBranch newRule = new RuleBranch(aPrecedence, aPredicate, aBody);
- LispError.check(newRule != null, LispError.CREATING_RULE);
-
- insertRule(aPrecedence, newRule);
- }
-
- /**
- * Add a TruePredicateRuleBranch to the list of rules.
- * See: insertRule()
- *
- * @param aPrecedence
- * @param aBody
- * @throws java.lang.Exception
- */
- public void declareRule(int aPrecedence, ConsPointer aBody) throws Exception {
- // New branching rule.
- RuleBranch newRule = new TruePredicateRuleBranch(aPrecedence, aBody);
- LispError.check(newRule != null, LispError.CREATING_RULE);
-
- insertRule(aPrecedence, newRule);
- }
-
- /**
- * Add a PatternBranch to the list of rules.
- * See: insertRule()
- *
- * @param aPrecedence
- * @param aPredicate
- * @param aBody
- * @throws java.lang.Exception
- */
- public void declarePattern(int aPrecedence, ConsPointer aPredicate, ConsPointer aBody) throws Exception {
- // New branching rule.
- PatternBranch newRule = new PatternBranch(aPrecedence, aPredicate, aBody);
- LispError.check(newRule != null, LispError.CREATING_RULE);
-
- insertRule(aPrecedence, newRule);
- }
-
- /**
- * Insert any Branch object in the list of rules.
- * This function does the real work for declareRule() and
- * declarePattern(): it inserts the rule in iRules, while
- * keeping it sorted. The algorithm is O(log n), where
- * n denotes the number of rules.
- *
- * @param aPrecedence
- * @param newRule
- */
- void insertRule(int aPrecedence, Branch newRule) {
- // Find place to insert
- int low, high, mid;
- low = 0;
- high = iBranchRules.size();
-
- // Constant time: find out if the precedence is before any of the
- // currently defined rules or past them.
- if (high > 0) {
- if (((Branch) iBranchRules.get(0)).getPrecedence() > aPrecedence) {
- mid = 0;
- // Insert it
- iBranchRules.add(mid, newRule);
- return;
- }
- if (((Branch) iBranchRules.get(high - 1)).getPrecedence() < aPrecedence) {
- mid = high;
- // Insert it
- iBranchRules.add(mid, newRule);
- return;
- }
- }
-
- // Otherwise, O(log n) search algorithm for place to insert
- for (;;) {
- if (low >= high) {
- mid = low;
- // Insert it
- iBranchRules.add(mid, newRule);
- return;
- }
- mid = (low + high) >> 1;
-
- if (((Branch) iBranchRules.get(mid)).getPrecedence() > aPrecedence) {
- high = mid;
- } else if (((Branch) iBranchRules.get(mid)).getPrecedence() < aPrecedence) {
- low = (++mid);
- } else {
- // Insert it
- iBranchRules.add(mid, newRule);
- return;
- }
- }
- }
-
- /**
- * Return the argument list, stored in #iParameterList.
- *
- * @return a ConsPointer
- */
- public ConsPointer argList() {
- return iParameterList;
- }
-
- public Iterator getRules() {
- return iBranchRules.iterator();
- }
-
- public Iterator getParameters() {
- return iParameters.iterator();
- }
-
- public void unFence() {
- iFenced = false;
- }
-
- public boolean fenced() {
- return iFenced;
- }
-}//end class.
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/TruePredicateRuleBranch.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/TruePredicateRuleBranch.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/userfunctions/TruePredicateRuleBranch.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/userfunctions/TruePredicateRuleBranch.java 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-/* {{{ License.
- * 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 2
- * of the License, or 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, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */ //}}}
-
-// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
-package org.mathpiper.lisp.userfunctions;
-
-import org.mathpiper.lisp.cons.ConsPointer;
-import org.mathpiper.lisp.Environment;
-
-/**
- * A rule that always matches.
- */
-class TruePredicateRuleBranch extends RuleBranch
-{
-
- public TruePredicateRuleBranch(int aPrecedence, ConsPointer aBody)
- {
- iPrecedence = aPrecedence;
- iBody.setCons(aBody.getCons());
- }
- /// Return #true, always.
- public boolean matches(Environment aEnvironment, ConsPointer[] aArguments) throws Exception
- {
- return true;
- }
-}
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Utility.java mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Utility.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/lisp/Utility.java 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/lisp/Utility.java 2011-04-24 07:45:56.000000000 +0000
@@ -16,7 +16,6 @@
// :indentSize=4:lineSeparator=\n:noTabs=false:tabSize=4:folding=explicit:collapseFolds=0:
package org.mathpiper.lisp;
-
import org.mathpiper.lisp.collections.OperatorMap;
import org.mathpiper.lisp.cons.ConsTraverser;
import org.mathpiper.lisp.cons.SublistCons;
@@ -28,29 +27,35 @@
import java.util.Iterator;
import java.util.Map;
import org.mathpiper.io.MathPiperInputStream;
+import org.mathpiper.io.MathPiperOutputStream;
import org.mathpiper.exceptions.EvaluationException;
import org.mathpiper.io.InputStatus;
import org.mathpiper.builtin.BigNumber;
import org.mathpiper.builtin.BuiltinFunction;
+import org.mathpiper.builtin.JavaObject;
import org.mathpiper.io.InputDirectories;
import org.mathpiper.lisp.behaviours.Substitute;
import org.mathpiper.lisp.tokenizers.MathPiperTokenizer;
-import org.mathpiper.lisp.userfunctions.MultipleArityUserFunction;
+import org.mathpiper.lisp.rulebases.MultipleArityRulebase;
import org.mathpiper.lisp.printers.MathPiperPrinter;
import org.mathpiper.lisp.parsers.MathPiperParser;
import org.mathpiper.io.JarFileInputStream;
import org.mathpiper.io.StandardFileInputStream;
+import org.mathpiper.io.StringInputStream;
+import org.mathpiper.io.StringOutput;
import org.mathpiper.io.StringOutputStream;
import org.mathpiper.lisp.behaviours.BackQuoteSubstitute;
+import org.mathpiper.lisp.cons.BuiltinObjectCons;
import org.mathpiper.lisp.cons.NumberCons;
-import org.mathpiper.lisp.parametermatchers.Pattern;
-import org.mathpiper.lisp.parametermatchers.PatternParameter;
-import org.mathpiper.lisp.userfunctions.Branch;
-import org.mathpiper.lisp.userfunctions.FunctionParameter;
-import org.mathpiper.lisp.userfunctions.MacroUserFunction;
-import org.mathpiper.lisp.userfunctions.PatternBranch;
-import org.mathpiper.lisp.userfunctions.SingleArityBranchingUserFunction;
-
+import org.mathpiper.lisp.parametermatchers.ParametersPatternMatcher;
+import org.mathpiper.lisp.parametermatchers.PatternParameterMatcher;
+import org.mathpiper.lisp.parsers.Parser;
+import org.mathpiper.lisp.printers.LispPrinter;
+import org.mathpiper.lisp.rulebases.Rule;
+import org.mathpiper.lisp.rulebases.ParameterName;
+import org.mathpiper.lisp.rulebases.MacroRulebase;
+import org.mathpiper.lisp.rulebases.PatternRule;
+import org.mathpiper.lisp.rulebases.SingleArityRulebase;
public class Utility {
@@ -96,7 +101,7 @@
5.
};
public static java.util.zip.ZipFile zipFile = null;
-
+ public static String scriptsPath = null;
public static boolean isNumber(String ptr, boolean aAllowFloat) {
@@ -166,19 +171,17 @@
return true;
}
-
- public static int listLength(ConsPointer aOriginal) throws Exception {
- ConsPointer consTraverser = new ConsPointer(aOriginal.getCons());
+ public static int listLength(Environment aEnvironment, int aStackTop, ConsPointer aOriginal) throws Exception {
+ ConsPointer consTraverser = new ConsPointer( aOriginal.getCons());
int length = 0;
while (consTraverser.getCons() != null) {
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop, aEnvironment);
length++;
}
return length;
}
-
- public static void reverseList(ConsPointer aResult, ConsPointer aOriginal) {
+ public static void reverseList(Environment aEnvironment, ConsPointer aResult, ConsPointer aOriginal) {
//ConsPointer iter = new ConsPointer(aOriginal);
ConsPointer iter = new ConsPointer();
iter.setCons(aOriginal.getCons());
@@ -195,88 +198,81 @@
aResult.setCons(previous.getCons());
}
-
- public static void returnUnEvaluated(ConsPointer aResult, ConsPointer aArguments, Environment aEnvironment) throws Exception {
+ public static void returnUnEvaluated(int aStackTop, ConsPointer aResult, ConsPointer aArguments, Environment aEnvironment) throws Exception {
ConsPointer full = new ConsPointer();
full.setCons(aArguments.getCons().copy(aEnvironment, false));
aResult.setCons(SublistCons.getInstance(aEnvironment, full.getCons()));
- ConsTraverser consTraverser = new ConsTraverser(aArguments);
- consTraverser.goNext();
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, aArguments);
+ consTraverser.goNext(aStackTop);
while (consTraverser.getCons() != null) {
ConsPointer next = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, next, consTraverser.getPointer());
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, next, consTraverser.getPointer());
full.cdr().setCons(next.getCons());
full.setCons(next.getCons());
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop);
}
full.cdr().setCons(null);
}
+ //Evaluate a function which is in string form.
+ public static void applyString(Environment aEnvironment, int aStackTop, ConsPointer aResult, String aOperator, ConsPointer aArgs) throws Exception {
+ LispError.check(aEnvironment, aStackTop, isString(aOperator), LispError.NOT_A_STRING, "INTERNAL");
- public static void applyString(Environment aEnvironment, ConsPointer aResult,
- String aOperator, ConsPointer aArgs) throws Exception {
- LispError.check(isString(aOperator), LispError.NOT_A_STRING);
-
- Cons head =
- AtomCons.getInstance(aEnvironment, getSymbolName(aEnvironment, aOperator));
+ Cons head = AtomCons.getInstance(aEnvironment, aStackTop, getSymbolName(aEnvironment, aOperator));
head.cdr().setCons(aArgs.getCons());
ConsPointer body = new ConsPointer();
body.setCons(SublistCons.getInstance(aEnvironment, head));
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aResult, body);
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, aResult, body);
}
-
- public static void applyPure(ConsPointer oper, ConsPointer args2, ConsPointer aResult, Environment aEnvironment) throws Exception {
- LispError.check(oper.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT);
- LispError.check(((ConsPointer) oper.car()).getCons() != null, LispError.INVALID_ARGUMENT);
+ public static void applyPure(int aStackTop, ConsPointer oper, ConsPointer args2, ConsPointer aResult, Environment aEnvironment) throws Exception {
+ LispError.check(aEnvironment, aStackTop, oper.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, ((ConsPointer) oper.car()).getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
ConsPointer oper2 = new ConsPointer();
oper2.setCons(((ConsPointer) oper.car()).cdr().getCons());
- LispError.check(oper2.getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, oper2.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
ConsPointer body = new ConsPointer();
body.setCons(oper2.cdr().getCons());
- LispError.check(body.getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, body.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
- LispError.check(oper2.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT);
- LispError.check(((ConsPointer) oper2.car()).getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, oper2.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, ((ConsPointer) oper2.car()).getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
oper2.setCons(((ConsPointer) oper2.car()).cdr().getCons());
aEnvironment.pushLocalFrame(false, "Pure");
try {
while (oper2.getCons() != null) {
- LispError.check(args2.getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, args2.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
String var = (String) oper2.car();
- LispError.check(var != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, var != null, LispError.INVALID_ARGUMENT, "INTERNAL");
ConsPointer newly = new ConsPointer();
newly.setCons(args2.getCons().copy(aEnvironment, false));
- aEnvironment.newLocalVariable(var, newly.getCons());
+ aEnvironment.newLocalVariable(var, newly.getCons(), aStackTop);
oper2.setCons(oper2.cdr().getCons());
args2.setCons(args2.cdr().getCons());
}
- LispError.check(args2.getCons() == null, LispError.INVALID_ARGUMENT);
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aResult, body);
+ LispError.check(aEnvironment, aStackTop, args2.getCons() == null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, aResult, body);
} catch (EvaluationException e) {
throw e;
} finally {
- aEnvironment.popLocalFrame();
+ aEnvironment.popLocalFrame(aStackTop);
}
}
-
public static void putTrueInPointer(Environment aEnvironment, ConsPointer aResult) throws Exception {
aResult.setCons(aEnvironment.iTrueAtom.copy(aEnvironment, false));
}
-
public static void putFalseInPointer(Environment aEnvironment, ConsPointer aResult) throws Exception {
aResult.setCons(aEnvironment.iFalseAtom.copy(aEnvironment, false));
}
-
public static void putBooleanInPointer(Environment aEnvironment, ConsPointer aResult, boolean aValue) throws Exception {
if (aValue) {
putTrueInPointer(aEnvironment, aResult);
@@ -285,39 +281,37 @@
}
}
-
- public static void nth(Environment aEnvironment, ConsPointer aResult, ConsPointer aArg, int n) throws Exception {
- LispError.check(aArg.getCons() != null, LispError.INVALID_ARGUMENT);
- LispError.check(aArg.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT);
- LispError.check(n >= 0, LispError.INVALID_ARGUMENT);
- ConsTraverser consTraverser = new ConsTraverser((ConsPointer) aArg.car());
+ public static void nth(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArg, int n) throws Exception {
+ LispError.check(aEnvironment, aStackTop, aArg.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, aArg.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, n >= 0, LispError.INVALID_ARGUMENT, "INTERNAL");
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, (ConsPointer) aArg.car());
while (n > 0) {
- LispError.check(consTraverser.getCons() != null, LispError.INVALID_ARGUMENT);
- consTraverser.goNext();
+ LispError.check(aEnvironment, aStackTop, consTraverser.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ consTraverser.goNext(aStackTop);
n--;
}
- LispError.check(consTraverser.getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, consTraverser.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
aResult.setCons(consTraverser.getCons().copy(aEnvironment, false));
}
-
- public static void tail(Environment aEnvironment, ConsPointer aResult, ConsPointer aArg) throws Exception {
- LispError.check(aArg.getCons() != null, LispError.INVALID_ARGUMENT);
- LispError.check(aArg.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT);
+ public static void tail(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aArg) throws Exception {
+ LispError.check(aEnvironment, aStackTop, aArg.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, aArg.car() instanceof ConsPointer, LispError.INVALID_ARGUMENT, "INTERNAL");
ConsPointer iter = (ConsPointer) aArg.car();
- LispError.check(iter.getCons() != null, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, iter.getCons() != null, LispError.INVALID_ARGUMENT, "INTERNAL");
aResult.setCons(SublistCons.getInstance(aEnvironment, iter.cdr().getCons()));
}
- public static boolean isTrue(Environment aEnvironment, ConsPointer aExpression) throws Exception {
- LispError.lispAssert(aExpression.getCons() != null);
+ public static boolean isTrue(Environment aEnvironment, ConsPointer aExpression, int aStackTop) throws Exception {
+ LispError.lispAssert(aExpression.getCons() != null, aEnvironment, aStackTop);
//return aExpression.car() == aEnvironment.iTrueAtom.car();
- return aExpression.car() instanceof String && ((String) aExpression.car()) == aEnvironment.iTrueString;
+ return aExpression.car() instanceof String && ((String) aExpression.car()).equals(aEnvironment.iTrueString);
/* Code which returns True for everything except False and {};
String expressionString = aExpression.car();
@@ -340,18 +334,15 @@
}*/
}//end method.
-
-
- public static boolean isFalse(Environment aEnvironment, ConsPointer aExpression) throws Exception {
- LispError.lispAssert(aExpression.getCons() != null);
- return aExpression.car() instanceof String && ((String) aExpression.car()) == aEnvironment.iFalseString;
+ public static boolean isFalse(Environment aEnvironment, ConsPointer aExpression, int aStackTop) throws Exception {
+ LispError.lispAssert(aExpression.getCons() != null, aEnvironment, aStackTop);
+ return aExpression.car() instanceof String && ((String) aExpression.car()).equals(aEnvironment.iFalseString);
/* Code which returns True for everything except False and {};
return aExpression.car() == aEnvironment.iFalseString || (isSublist(aExpression) && (listLength(aExpression.car()) == 1));
*/
}
-
public static String getSymbolName(Environment aEnvironment, String aSymbol) {
if (aSymbol.charAt(0) == '\"') {
return aEnvironment.getTokenHash().lookUpUnStringify(aSymbol);
@@ -360,7 +351,6 @@
}
}
-
public static boolean isSublist(ConsPointer aPtr) throws Exception {
/**
* todo:tk: I am currently not sure why non nested lists are not supported in Yacas.
@@ -382,7 +372,6 @@
}//end method.
-
public static boolean isList(ConsPointer aPtr) throws Exception {
/**
* todo:tk: I am currently not sure why non nested lists are not supported in Yacas.
@@ -404,16 +393,15 @@
}//end method.
+ public static boolean isNestedList(Environment aEnvironment, int aStackTop, ConsPointer clientListPointer) throws Exception {
- public static boolean isNestedList(ConsPointer clientListPointer) throws Exception {
-
- ConsPointer listPointer = new ConsPointer(clientListPointer.getCons());
+ ConsPointer listPointer = new ConsPointer( clientListPointer.getCons());
- listPointer.goNext(); //Strip List tag.
+ listPointer.goNext(aStackTop, aEnvironment); //Strip List tag.
while (listPointer.getCons() != null) {
if (listPointer.car() instanceof ConsPointer && isList((ConsPointer) listPointer.car())) {
- listPointer.goNext();
+ listPointer.goNext(aStackTop, aEnvironment);
} else {
return false;
}
@@ -421,30 +409,29 @@
return true;
}//end method.
-
- public static Map optionsListToJavaMap(ConsPointer argumentsPointer, Map defaultOptions) throws Exception {
+ public static Map optionsListToJavaMap(Environment aEnvironment, int aStackTop, ConsPointer argumentsPointer, Map defaultOptions) throws Exception {
Map userOptions = (Map) ((HashMap) defaultOptions).clone();
while (argumentsPointer.getCons() != null) {
//Obtain -> operator.
ConsPointer optionPointer = (ConsPointer) argumentsPointer.car();
- LispError.check(optionPointer.type() == Utility.ATOM, LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, optionPointer.type() == Utility.ATOM, LispError.INVALID_ARGUMENT, "INTERNAL");
String operator = (String) optionPointer.car();
- LispError.check(operator.equals("->"), LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, operator.equals("->"), LispError.INVALID_ARGUMENT, "INTERNAL");
//Obtain key.
- optionPointer.goNext();
- LispError.check(optionPointer.type() == Utility.ATOM, LispError.INVALID_ARGUMENT);
+ optionPointer.goNext(aStackTop, aEnvironment);
+ LispError.check(aEnvironment, aStackTop, optionPointer.type() == Utility.ATOM, LispError.INVALID_ARGUMENT, "INTERNAL");
String key = (String) optionPointer.car();
- key = Utility.stripEndQuotes(key);
+ key = Utility.stripEndQuotesIfPresent(aEnvironment, aStackTop, key);
//Obtain value.
- optionPointer.goNext();
- LispError.check(optionPointer.type() == Utility.ATOM || optionPointer.type() == Utility.NUMBER, LispError.INVALID_ARGUMENT);
+ optionPointer.goNext(aStackTop, aEnvironment);
+ LispError.check(aEnvironment, aStackTop, optionPointer.type() == Utility.ATOM || optionPointer.type() == Utility.NUMBER, LispError.INVALID_ARGUMENT, "INTERNAL");
if (optionPointer.type() == Utility.ATOM) {
String value = (String) optionPointer.car();
- value = Utility.stripEndQuotes(value);
+ value = Utility.stripEndQuotesIfPresent(aEnvironment, aStackTop, value);
if (value.equalsIgnoreCase("true") || value.equalsIgnoreCase("false")) {
userOptions.put(key, Boolean.parseBoolean(value));
} else {
@@ -453,21 +440,20 @@
} else //Number
{
NumberCons numberCons = (NumberCons) optionPointer.getCons();
- BigNumber bigNumber = (BigNumber) numberCons.getNumber(10);
+ BigNumber bigNumber = (BigNumber) numberCons.getNumber(10, aEnvironment);
Double value = bigNumber.toDouble();
userOptions.put(key, value);
}//end if/else.
- argumentsPointer.goNext();
+ argumentsPointer.goNext(aStackTop, aEnvironment);
}//end while
return userOptions;
}//end method.
-
public static boolean isString(Object aOriginal) {
if (!(aOriginal instanceof String)) {
@@ -487,9 +473,10 @@
}//end method
- public static String stripEndQuotes(String aOriginal) throws Exception {
- //If there are not quotes on both ends of the string then return without any changes.
- if (aOriginal.startsWith("\"") && aOriginal.endsWith("\"")) {
+ public static String stripEndDollarSigns(String aOriginal) throws Exception {
+ //If there are not dollar signs on both ends of the string then return without any changes.
+ aOriginal = aOriginal.trim();
+ if (aOriginal.startsWith("$") && aOriginal.endsWith("$")) {
aOriginal = aOriginal.substring(1, aOriginal.length());
aOriginal = aOriginal.substring(0, aOriginal.length() - 1);
}//end if.
@@ -497,38 +484,35 @@
return aOriginal;
}//end method.
-
- public static void not(ConsPointer aResult, Environment aEnvironment, ConsPointer aExpression) throws Exception {
- if (isTrue(aEnvironment, aExpression)) {
+ public static void not(int aStackTop, ConsPointer aResult, Environment aEnvironment, ConsPointer aExpression) throws Exception {
+ if (isTrue(aEnvironment, aExpression, aStackTop)) {
putFalseInPointer(aEnvironment, aResult);
} else {
- LispError.check(isFalse(aEnvironment, aExpression), LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, isFalse(aEnvironment, aExpression, aStackTop), LispError.INVALID_ARGUMENT, "INTERNAL");
putTrueInPointer(aEnvironment, aResult);
}
}
-
- public static void flatCopy(Environment aEnvironment, ConsPointer aResult, ConsPointer aOriginal) throws Exception {
- ConsTraverser orig = new ConsTraverser(aOriginal);
- ConsTraverser res = new ConsTraverser(aResult);
+ public static void flatCopy(Environment aEnvironment, int aStackTop, ConsPointer aResult, ConsPointer aOriginal) throws Exception {
+ ConsTraverser orig = new ConsTraverser(aEnvironment, aOriginal);
+ ConsTraverser res = new ConsTraverser(aEnvironment, aResult);
while (orig.getCons() != null) {
res.getPointer().setCons(orig.getCons().copy(aEnvironment, false));
- orig.goNext();
- res.goNext();
+ orig.goNext(aStackTop);
+ res.goNext(aStackTop);
}
}
-
- public static boolean equals(Environment aEnvironment, ConsPointer aExpression1, ConsPointer aExpression2) throws Exception {
+ public static boolean equals(Environment aEnvironment, int aStackTop, ConsPointer aExpression1, ConsPointer aExpression2) throws Exception {
// Handle pointers to same, or null
if (aExpression1.getCons() == aExpression2.getCons()) {
return true;
}
//LispError.check(aExpression1.type().equals("Number"), LispError.INVALID_ARGUMENT);
//LispError.check(aExpression2.type().equals("Number"), LispError.INVALID_ARGUMENT);
- BigNumber n1 = (BigNumber) aExpression1.getCons().getNumber(aEnvironment.getPrecision());
- BigNumber n2 = (BigNumber) aExpression2.getCons().getNumber(aEnvironment.getPrecision());
+ BigNumber n1 = (BigNumber) aExpression1.getCons().getNumber(aEnvironment.getPrecision(), aEnvironment);
+ BigNumber n2 = (BigNumber) aExpression2.getCons().getNumber(aEnvironment.getPrecision(), aEnvironment);
if (!(n1 == null && n2 == null)) {
if (n1 == n2) {
return true;
@@ -563,18 +547,18 @@
if (!(aExpression2.car() instanceof ConsPointer)) {
return false;
}
- ConsTraverser consTraverser1 = new ConsTraverser((ConsPointer) aExpression1.car());
- ConsTraverser consTraverser2 = new ConsTraverser((ConsPointer) aExpression2.car());
+ ConsTraverser consTraverser1 = new ConsTraverser(aEnvironment, (ConsPointer) aExpression1.car());
+ ConsTraverser consTraverser2 = new ConsTraverser(aEnvironment, (ConsPointer) aExpression2.car());
while (consTraverser1.getCons() != null && consTraverser2.getCons() != null) {
// compare two list elements
- if (!equals(aEnvironment, consTraverser1.getPointer(), consTraverser2.getPointer())) {
+ if (!equals(aEnvironment, aStackTop, consTraverser1.getPointer(), consTraverser2.getPointer())) {
return false;
}
// Step to rest
- consTraverser1.goNext();
- consTraverser2.goNext();
+ consTraverser1.goNext(aStackTop);
+ consTraverser2.goNext(aStackTop);
}
// Lists don't have the same length
if (consTraverser1.getCons() != consTraverser2.getCons()) {
@@ -587,11 +571,10 @@
return false;
}
-
- public static void substitute(Environment aEnvironment, ConsPointer aTarget, ConsPointer aSource, Substitute aBehaviour) throws Exception {
+ public static void substitute(Environment aEnvironment, int aStackTop, ConsPointer aTarget, ConsPointer aSource, Substitute aBehaviour) throws Exception {
Cons object = aSource.getCons();
- LispError.lispAssert(object != null);
- if (!aBehaviour.matches(aEnvironment, aTarget, aSource)) {
+ LispError.lispAssert(object != null, aEnvironment, aStackTop);
+ if (!aBehaviour.matches(aEnvironment, aStackTop, aTarget, aSource)) {
Object oldList = object.car();
ConsPointer oldListPointer = null;
@@ -604,7 +587,7 @@
ConsPointer newList = new ConsPointer();
ConsPointer next = newList;
while (oldListPointer.getCons() != null) {
- substitute(aEnvironment, next, oldListPointer, aBehaviour);
+ substitute(aEnvironment, aStackTop, next, oldListPointer, aBehaviour);
oldListPointer = oldListPointer.cdr();
next = next.cdr();
}
@@ -616,16 +599,33 @@
}
- public static String unstringify(String aOriginal) throws Exception {
- LispError.check(aOriginal != null, LispError.INVALID_ARGUMENT);
- LispError.check(aOriginal.charAt(0) == '\"', LispError.INVALID_ARGUMENT);
+ public static String stripEndQuotesIfPresent(Environment aEnvironment, int aStackTop, String aOriginal) throws Exception {
+ //If there are not quotes on both ends of the string then return without any changes.
+ if (aOriginal.startsWith("\"") && aOriginal.endsWith("\"")) {
+ aOriginal = aOriginal.substring(1, aOriginal.length());
+ aOriginal = aOriginal.substring(0, aOriginal.length() - 1);
+ }//end if.
+
+ return aOriginal;
+ }//end method.
+
+
+
+ public static String toNormalString(Environment aEnvironment, int aStackTop, String aOriginal) throws Exception {
+ LispError.check(aEnvironment, aStackTop, aOriginal != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+ LispError.check(aEnvironment, aStackTop, aOriginal.charAt(0) == '\"', LispError.INVALID_ARGUMENT, "INTERNAL");
int nrc = aOriginal.length() - 1;
- LispError.check(aOriginal.charAt(nrc) == '\"', LispError.INVALID_ARGUMENT);
+ LispError.check(aEnvironment, aStackTop, aOriginal.charAt(nrc) == '\"', LispError.INVALID_ARGUMENT, "INTERNAL");
return aOriginal.substring(1, nrc);
}
+ public static String toMathPiperString(Environment aEnvironment, int aStackTop, String aOriginal) throws Exception {
+ LispError.check(aEnvironment, aStackTop, aOriginal != null, LispError.INVALID_ARGUMENT, "INTERNAL");
+
+ return "\"" + aOriginal + "\"";
+ }
- private static void doInternalLoad(Environment aEnvironment, MathPiperInputStream aInput) throws Exception {
+ private static void doInternalLoad(Environment aEnvironment, int aStackTop, MathPiperInputStream aInput) throws Exception {
MathPiperInputStream previous = aEnvironment.iCurrentInput;
try {
aEnvironment.iCurrentInput = aInput;
@@ -640,39 +640,40 @@
ConsPointer readIn = new ConsPointer();
while (!endoffile) {
// Read expression
- parser.parse(aEnvironment, readIn);
+ parser.parse(aStackTop, readIn);
- LispError.check(readIn.getCons() != null, LispError.READING_FILE);
+ LispError.check(aEnvironment, aStackTop, readIn.getCons() != null, LispError.READING_FILE, "INTERNAL");
// check for end of file
- if (readIn.car() instanceof String && ((String) readIn.car()) == eof) {
+ if (readIn.car() instanceof String && ((String) readIn.car()).equals(eof)) {
endoffile = true;
} // Else evaluate
else {
ConsPointer result = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, result, readIn);
- aEnvironment.setGlobalVariable("LoadResult", result, false);//Note:tk:added to make the result of executing Loaded code available.
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, result, readIn);
+ aEnvironment.setGlobalVariable(aStackTop, "$LoadResult", result, false);//Note:tk:added to make the result of executing Loaded code available.
}
}//end while.
} catch (Exception e) {
- EvaluationException ee = new EvaluationException(e.getMessage(), aEnvironment.iCurrentInput.iStatus.lineNumber());
+ //e.printStackTrace(); //todo:tk:uncomment for debugging.
+
+ EvaluationException ee = new EvaluationException(e.getMessage(), aEnvironment.iInputStatus.fileName(), aEnvironment.iCurrentInput.iStatus.lineNumber());
throw ee;
} finally {
aEnvironment.iCurrentInput = previous;
}
}
-
/**
* Searches for a file on the classpath then in the default directories. If the file is found, it is loaded.
* @param aEnvironment
* @param aFileName
* @throws java.lang.Exception
*/
- public static void load(Environment aEnvironment, String aFileName) throws Exception {
- String oper = unstringify(aFileName);
+ public static void loadScript(Environment aEnvironment, int aStackTop, String aFileName) throws Exception {
+ String oper = toNormalString(aEnvironment, aStackTop, aFileName);
String hashedname = (String) aEnvironment.getTokenHash().lookUp(oper);
@@ -681,27 +682,32 @@
MathPiperInputStream newInput = null;
- /*java.io.MathPiperInputStream scriptStream = Scripts.getScriptStream(oper);
- if (scriptStream != null) {
- newInput = new StandardFileInputStream(scriptStream, aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doInternalLoad(aEnvironment, newInput);
- } else {*/
-//System.out.println("Loading: " + oper);
- java.net.URL fileURL = java.lang.ClassLoader.getSystemResource(oper);
- if (fileURL != null) //File is on the classpath.
+ String path = Utility.scriptsPath + oper;
+
+ //Try to find script on classpath + scriptspath.
+ java.io.InputStream inputStream = Utility.class.getResourceAsStream(path);
+
+ //Try to find script on classpath.
+ if(inputStream == null)
+ {
+ inputStream = Utility.class.getResourceAsStream(oper);
+ }
+
+
+ if (inputStream != null) //File is on the classpath.
{
- newInput = new StandardFileInputStream(new InputStreamReader(fileURL.openStream()), aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doInternalLoad(aEnvironment, newInput);
+ newInput = new StandardFileInputStream(new InputStreamReader(inputStream), aEnvironment.iInputStatus);
+ LispError.check(aEnvironment, aStackTop, newInput != null, LispError.FILE_NOT_FOUND, "INTERNAL");
+ doInternalLoad(aEnvironment, aStackTop, newInput);
+
} else { //File may be in the filesystem.
try {
// Open file
newInput = // new StandardFileInputStream(hashedname, aEnvironment.iInputStatus);
openInputFile(aEnvironment, aEnvironment.iInputDirectories, hashedname, aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doInternalLoad(aEnvironment, newInput);
+ LispError.check(aEnvironment, aStackTop, newInput != null, LispError.FILE_NOT_FOUND, "INTERNAL");
+ doInternalLoad(aEnvironment, aStackTop, newInput);
} catch (Exception e) {
throw e;
} finally {
@@ -715,26 +721,58 @@
}
-
- public static void use(Environment aEnvironment, String aFileName) throws Exception {
+ public static void loadScriptOnce(Environment aEnvironment, int aStackTop, String aFileName) throws Exception {
DefFile def = aEnvironment.iDefFiles.getFile(aFileName);
if (!def.isLoaded()) {
def.setLoaded();
- load(aEnvironment, aFileName);
+ loadScript(aEnvironment, aStackTop, aFileName);
+ }
+ }
+
+ public static void doPatchString(String unpatchedString, MathPiperOutputStream aOutput, Environment aEnvironment, int aStackTop) throws Exception
+ {
+ String[] tags = unpatchedString.split("\\?\\>");
+ if (tags.length > 1) {
+ for (int x = 0; x < tags.length; x++) {
+ String[] tag = tags[x].split("\\<\\?");
+ if (tag.length > 1) {
+ aOutput.write(tag[0]);
+ String scriptCode = tag[1].trim();
+ StringBuffer scriptCodeBuffer =
+ new StringBuffer(scriptCode);
+ StringInputStream scriptStream =
+ new StringInputStream(scriptCodeBuffer, aEnvironment.iInputStatus);
+ MathPiperOutputStream previous =
+ aEnvironment.iCurrentOutput;
+ try {
+ aEnvironment.iCurrentOutput = aOutput;
+ Utility.doInternalLoad(aEnvironment, aStackTop, scriptStream);
+ } catch(Exception e) {
+ throw e;
+ } finally {
+ aEnvironment.iCurrentOutput = previous;
+ }
+ }
+ } // end for
+ aOutput.write(tags[tags.length - 1]);
+ } else {
+ aOutput.write(unpatchedString);
}
}
+ public static String printMathPiperExpression(int aStackTop, ConsPointer aExpression, Environment aEnvironment, int aMaxChars) throws Exception {
+ if(aExpression.getCons() == null)
+ {
+ return "NULL";
+ }
- public static String printExpression(ConsPointer aExpression,
- Environment aEnvironment,
- int aMaxChars) throws Exception {
StringBuffer result = new StringBuffer();
StringOutputStream newOutput = new StringOutputStream(result);
MathPiperPrinter infixprinter = new MathPiperPrinter(aEnvironment.iPrefixOperators,
aEnvironment.iInfixOperators,
aEnvironment.iPostfixOperators,
aEnvironment.iBodiedOperators);
- infixprinter.print(aExpression, newOutput, aEnvironment);
+ infixprinter.print(aStackTop, aExpression, newOutput, aEnvironment);
if (aMaxChars > 0 && result.length() > aMaxChars) {
result.delete(aMaxChars, result.length());
result.append((char) '.');
@@ -742,10 +780,28 @@
result.append((char) '.');
}
return result.toString();
- }
+ }//end method.
+
+
+ public static String printLispExpression( int aStackTop, ConsPointer aExpression, Environment aEnvironment, int aMaxChars) throws Exception {
+ if(aExpression.getCons() == null)
+ {
+ return "NULL";
+ }
+
+ StringOutput out = new StringOutput();
+ LispPrinter printer = new LispPrinter();
+
+ printer.print(aStackTop, aExpression, out, aEnvironment);
+
+ //todo:tk:add the ability to truncate the result.
+
+ return out.toString();
+ }
public static MathPiperInputStream openInputFile(String aFileName, InputStatus aInputStatus) throws Exception {//Note:tk:primary method for file opening.
+
try {
if (zipFile != null) {
java.util.zip.ZipEntry e = zipFile.getEntry(aFileName);
@@ -768,7 +824,6 @@
//return new StandardFileInputStream(aFileName, aInputStatus);
}
-
public static MathPiperInputStream openInputFile(Environment aEnvironment,
InputDirectories aInputDirectories, String aFileName,
InputStatus aInputStatus) throws Exception {
@@ -783,7 +838,6 @@
return f;
}
-
public static String findFile(String aFileName, InputDirectories aInputDirectories) throws Exception {
InputStatus inputStatus = new InputStatus();
String othername = aFileName;
@@ -803,8 +857,7 @@
return "";
}
-
- private static void doLoadDefFile(Environment aEnvironment, MathPiperInputStream aInput, DefFile def) throws Exception {
+ private static void doLoadDefFile(Environment aEnvironment, int aStackTop, MathPiperInputStream aInput, DefFile def) throws Exception {
MathPiperInputStream previous = aEnvironment.iCurrentInput;
try {
aEnvironment.iCurrentInput = aInput;
@@ -816,17 +869,17 @@
while (!endoffile) {
// Read expression
- String token = tok.nextToken(aEnvironment.iCurrentInput, aEnvironment.getTokenHash());
+ String token = tok.nextToken(aEnvironment, aStackTop, aEnvironment.iCurrentInput, aEnvironment.getTokenHash());
// check for end of file
- if (token == eof || token == end) {
+ if (token.equals(eof) || token.equals(end)) {
endoffile = true;
} // Else evaluate
else {
String str = token;
- MultipleArityUserFunction multiUser = aEnvironment.getMultipleArityUserFunction(str, true);
+ MultipleArityRulebase multiUser = aEnvironment.getMultipleArityRulebase(aStackTop, str, true);
if (multiUser.iFileToOpen != null) {
- throw new EvaluationException("[" + str + "]" + "] : def file already chosen: " + multiUser.iFileToOpen.iFileName, -1);
+ throw new EvaluationException("[" + str + "]" + "] : def file already chosen: " + multiUser.iFileToOpen.iFileName, aEnvironment.iInputStatus.fileName(), aEnvironment.iCurrentInput.iStatus.lineNumber());
}
multiUser.iFileToOpen = def;
multiUser.iFileLocation = def.fileName();
@@ -839,11 +892,10 @@
}
}
+ public static void loadDefFile(Environment aEnvironment, int aStackTop, String aFileName) throws Exception {
+ LispError.lispAssert(aFileName != null, aEnvironment, aStackTop);
- public static void loadDefFile(Environment aEnvironment, String aFileName) throws Exception {
- LispError.lispAssert(aFileName != null);
-
- String flatfile = unstringify(aFileName) + ".def";
+ String flatfile = toNormalString(aEnvironment, aStackTop, aFileName) + ".def";
DefFile def = aEnvironment.iDefFiles.getFile(aFileName);
String hashedname = (String) aEnvironment.getTokenHash().lookUp(flatfile);
@@ -852,30 +904,25 @@
aEnvironment.iInputStatus.setTo(hashedname);
-
MathPiperInputStream newInput = null;
+ String path = Utility.scriptsPath + flatfile;
- /* java.io.MathPiperInputStream scriptStream = Scripts.getScriptStream(flatfile);
- if (scriptStream != null) {
- newInput = new StandardFileInputStream(scriptStream, aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doLoadDefFile(aEnvironment, newInput, def);
- } else {*/
-//System.out.println("Loading: " + flatfile);
- java.net.URL fileURL = java.lang.ClassLoader.getSystemResource(flatfile);
- if (fileURL != null) //File is on the classpath.
+ java.io.InputStream inputStream = Utility.class.getResourceAsStream(path);
+
+
+ if (inputStream != null) //File is on the classpath.
{
- newInput = new StandardFileInputStream(new InputStreamReader(fileURL.openStream()), aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doLoadDefFile(aEnvironment, newInput, def);
+ newInput = new StandardFileInputStream(new InputStreamReader(inputStream), aEnvironment.iInputStatus);
+ LispError.check(aEnvironment, aStackTop, newInput != null, LispError.FILE_NOT_FOUND, "INTERNAL");
+ doLoadDefFile(aEnvironment, aStackTop, newInput, def);
} else //File may be in the filesystem.
{
newInput = // new StandardFileInputStream(hashedname, aEnvironment.iInputStatus);
openInputFile(aEnvironment, aEnvironment.iInputDirectories, hashedname, aEnvironment.iInputStatus);
- LispError.check(newInput != null, LispError.FILE_NOT_FOUND);
- doLoadDefFile(aEnvironment, newInput, def);
+ LispError.check(aEnvironment, aStackTop, newInput != null, LispError.FILE_NOT_FOUND, "INTERNAL");
+ doLoadDefFile(aEnvironment, aStackTop, newInput, def);
}
aEnvironment.iInputStatus.restoreFrom(oldstatus);
@@ -886,22 +933,19 @@
// lookup table for transforming the number of digits
// report the table size
-
int log2TableRange() {
return log2_table_size;
}
// table look-up of small integer logarithms, for converting the number of digits to binary and back
-
static double log2TableLookup(int n) throws Exception {
if (n <= log2_table_size && n >= 2) {
return log2_table[n - 1];
} else {
- throw new EvaluationException("log2_table_lookup: error: invalid argument " + n, -1);
+ throw new EvaluationException("log2_table_lookup: error: invalid argument " + n, "none", -1);
}
}
-
/**
* Convert the number of digits in given base to the number of bits. To make sure there is no hysteresis, the returned
* value is rounded up.
@@ -915,7 +959,6 @@
return (long) Math.ceil(((double) digits) * log2TableLookup(base));
}
-
/**
* Convert the number of bits in a given base to the number of digits. To make sure there is no hysteresis, the returned
* value is rounded down.
@@ -930,7 +973,6 @@
}
//************************* The following methods were taken from the Functions class.
-
/**
* Construct a {@link BigNumber}.
* @param aEnvironment the current {@link Environment}.
@@ -941,53 +983,49 @@
*/
public static BigNumber getNumber(Environment aEnvironment, int aStackTop, int aArgNr) throws Exception {
//LispError.check(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, aArgNr).type().equals("Number"), LispError.INVALID_ARGUMENT);
- BigNumber x = (BigNumber) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, aArgNr).getCons().getNumber(aEnvironment.getPrecision());
- LispError.checkArgument(aEnvironment, aStackTop, x != null, aArgNr);
+ BigNumber x = (BigNumber) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, aArgNr).getCons().getNumber(aEnvironment.getPrecision(), aEnvironment);
+ LispError.checkArgument(aEnvironment, aStackTop, x != null, aArgNr, "INTERNAL");
return x;
}
-
public static void multiFix(Environment aEnvironment, int aStackTop, OperatorMap aOps) throws Exception {
// Get operator
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
String orig = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1, "INTERNAL");
ConsPointer precedence = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, precedence, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2));
- LispError.checkArgument(aEnvironment, aStackTop, precedence.car() instanceof String, 2);
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, precedence, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2));
+ LispError.checkArgument(aEnvironment, aStackTop, precedence.car() instanceof String, 2, "INTERNAL");
int prec = Integer.parseInt((String) precedence.car(), 10);
- LispError.checkArgument(aEnvironment, aStackTop, prec <= MathPiperPrinter.KMaxPrecedence, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, prec <= MathPiperPrinter.KMaxPrecedence, 2, "INTERNAL");
aOps.setOperator(prec, Utility.getSymbolName(aEnvironment, orig));
Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
}
-
public static void singleFix(int aPrecedence, Environment aEnvironment, int aStackTop, OperatorMap aOps) throws Exception {
// Get operator
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
String orig = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1, "INTERNAL");
aOps.setOperator(aPrecedence, Utility.getSymbolName(aEnvironment, orig));
Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
}
-
- public static InfixOperator operatorInfo(Environment aEnvironment, int aStackTop, OperatorMap aOperators) throws Exception {
+ public static Operator operatorInfo(Environment aEnvironment, int aStackTop, OperatorMap aOperators) throws Exception {
// Get operator
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
ConsPointer evaluated = new ConsPointer();
evaluated.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons());
String orig = (String) evaluated.car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1, "INTERNAL");
//
- InfixOperator op = (InfixOperator) aOperators.lookUp(Utility.getSymbolName(aEnvironment, orig));
+ Operator op = (Operator) aOperators.lookUp(Utility.getSymbolName(aEnvironment, orig));
return op;
}
-
/**
* Sets a variable in the current {@link Environment}.
* @param aEnvironment holds the execution environment of the program.
@@ -1000,43 +1038,42 @@
String variableString = null;
if (aMacroMode) {
ConsPointer result = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, result, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1));
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, result, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1));
variableString = (String) result.car();
} else {
variableString = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
}
- LispError.checkArgument(aEnvironment, aStackTop, variableString != null, 1);
- LispError.checkArgument(aEnvironment, aStackTop, !Utility.isNumber(variableString, true), 1);
+ LispError.checkArgument(aEnvironment, aStackTop, variableString != null, 1, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, !Utility.isNumber(variableString, true), 1, "INTERNAL");
ConsPointer result = new ConsPointer();
- aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, result, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2));
- aEnvironment.setGlobalVariable(variableString, result, aGlobalLazyVariable); //Variable setting is deligated to Environment.
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, result, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2));
+ aEnvironment.setGlobalVariable(aStackTop, variableString, result, aGlobalLazyVariable); //Variable setting is deligated to Environment.
Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
}
-
public static void delete(Environment aEnvironment, int aStackTop, boolean aDestructive) throws Exception {
ConsPointer evaluated = new ConsPointer();
evaluated.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons());
- LispError.checkIsList(aEnvironment, aStackTop, evaluated, 1);
+ LispError.checkIsList(aEnvironment, aStackTop, evaluated, 1, "INTERNAL");
ConsPointer copied = new ConsPointer();
if (aDestructive) {
copied.setCons(((ConsPointer) evaluated.car()).getCons());
} else {
- Utility.flatCopy(aEnvironment, copied, (ConsPointer) evaluated.car());
+ Utility.flatCopy(aEnvironment, aStackTop, copied, (ConsPointer) evaluated.car());
}
ConsPointer index = new ConsPointer();
index.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2, "INTERNAL");
int ind = Integer.parseInt((String) index.car(), 10);
- LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2, "INTERNAL");
- ConsTraverser consTraverser = new ConsTraverser(copied);
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, copied);
while (ind > 0) {
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop);
ind--;
}
LispError.check(aEnvironment, aStackTop, consTraverser.getCons() != null, LispError.NOT_LONG_ENOUGH);
@@ -1046,29 +1083,28 @@
BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop).setCons(SublistCons.getInstance(aEnvironment, copied.getCons()));
}
-
public static void insert(Environment aEnvironment, int aStackTop, boolean aDestructive) throws Exception {
ConsPointer evaluated = new ConsPointer();
evaluated.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons());
- LispError.checkIsList(aEnvironment, aStackTop, evaluated, 1);
+ LispError.checkIsList(aEnvironment, aStackTop, evaluated, 1, "INTERNAL");
ConsPointer copied = new ConsPointer();
if (aDestructive) {
copied.setCons(((ConsPointer) evaluated.car()).getCons());
} else {
- Utility.flatCopy(aEnvironment, copied, (ConsPointer) evaluated.car());
+ Utility.flatCopy(aEnvironment, aStackTop, copied, (ConsPointer) evaluated.car());
}
ConsPointer index = new ConsPointer();
index.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2, "INTERNAL");
int ind = Integer.parseInt((String) index.car(), 10);
- LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2, "INTERNAL");
- ConsTraverser consTraverser = new ConsTraverser(copied);
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, copied);
while (ind > 0) {
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop);
ind--;
}
@@ -1079,130 +1115,134 @@
BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop).setCons(SublistCons.getInstance(aEnvironment, copied.getCons()));
}
-
public static void replace(Environment aEnvironment, int aStackTop, boolean aDestructive) throws Exception {
ConsPointer evaluated = new ConsPointer();
evaluated.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons());
// Ok, so lets not check if it is a list, but it needs to be at least a 'function'
- LispError.checkArgument(aEnvironment, aStackTop, evaluated.car() instanceof ConsPointer, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, evaluated.car() instanceof ConsPointer, 1, "INTERNAL");
ConsPointer index = new ConsPointer();
index.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, index.getCons() != null, 2, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, index.car() instanceof String, 2, "INTERNAL");
int ind = Integer.parseInt((String) index.car(), 10);
ConsPointer copied = new ConsPointer();
if (aDestructive) {
copied.setCons(((ConsPointer) evaluated.car()).getCons());
} else {
- Utility.flatCopy(aEnvironment, copied, (ConsPointer) evaluated.car());
+ Utility.flatCopy(aEnvironment, aStackTop, copied, (ConsPointer) evaluated.car());
}
- LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, ind > 0, 2, "INTERNAL");
- ConsTraverser consTraverser = new ConsTraverser(copied);
+ ConsTraverser consTraverser = new ConsTraverser(aEnvironment, copied);
while (ind > 0) {
- consTraverser.goNext();
+ consTraverser.goNext(aStackTop);
ind--;
}
ConsPointer toInsert = new ConsPointer();
toInsert.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 3).getCons());
- LispError.checkArgument(aEnvironment, aStackTop, consTraverser.getPointer() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, consTraverser.getPointer().getCons() != null, 2);
+ LispError.checkArgument(aEnvironment, aStackTop, consTraverser.getPointer() != null, 2, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, consTraverser.getPointer().getCons() != null, 2, "INTERNAL");
toInsert.cdr().setCons(consTraverser.getPointer().cdr().getCons());
consTraverser.getPointer().setCons(toInsert.getCons());
BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop).setCons(SublistCons.getInstance(aEnvironment, copied.getCons()));
}
-
/**
- *Implements the MathPiper functions RuleBase and MacroRuleBase .
- * The real work is done by Environment.declareRulebase().
+ *Implements the MathPiper functions Rulebase and MacroRulebase .
+ * The real work is done by Environment.defineRulebase().
*/
- public static void ruleDatabase(Environment aEnvironment, int aStackTop, boolean aListed) throws Exception {
- //TESTARGS(3);
+ public static void rulebase(Environment aEnvironment, int aStackTop, boolean aListed) throws Exception {
// Get operator
ConsPointer argsPointer = new ConsPointer();
String functionName = null;
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
functionName = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, functionName != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, functionName != null, 1, "INTERNAL");
argsPointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
// Check the arguments.
- LispError.checkIsList(aEnvironment, aStackTop, argsPointer, 2);
+ LispError.checkIsList(aEnvironment, aStackTop, argsPointer, 2, "INTERNAL");
// Finally define the rule database.
- aEnvironment.declareRulebase(Utility.getSymbolName(aEnvironment, functionName),
- ((ConsPointer) argsPointer.car()).cdr(), aListed);
+ aEnvironment.defineRulebase(aStackTop, Utility.getSymbolName(aEnvironment, functionName), ((ConsPointer) argsPointer.car()).cdr(), aListed);
// Return true
Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
}
-
- public static void newRule(Environment aEnvironment, int aStackTop) throws Exception {
- //TESTARGS(6);
+ public static void newRule(Environment aEnvironment, int aStackTop, boolean aPattern) throws Exception {
int arity;
int precedence;
- ConsPointer ar = new ConsPointer();
- ConsPointer pr = new ConsPointer();
+ ConsPointer arityPointer = new ConsPointer();
+ ConsPointer precidencePointer = new ConsPointer();
ConsPointer predicate = new ConsPointer();
- ConsPointer body = new ConsPointer();
+ ConsPointer bodyPointer = new ConsPointer();
String orig = null;
// Get operator
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
orig = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
- ar.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- pr.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 3).getCons());
+ LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1, "INTERNAL");
+ arityPointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
+ precidencePointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 3).getCons());
predicate.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 4).getCons());
- body.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 5).getCons());
+ bodyPointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 5).getCons());
// The arity
- LispError.checkArgument(aEnvironment, aStackTop, ar.getCons() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, ar.car() instanceof String, 2);
- arity = Integer.parseInt((String) ar.car(), 10);
+ LispError.checkArgument(aEnvironment, aStackTop, arityPointer.getCons() != null, 2, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, arityPointer.car() instanceof String, 2, "INTERNAL");
+ arity = Integer.parseInt((String) arityPointer.car(), 10);
// The precedence
- LispError.checkArgument(aEnvironment, aStackTop, pr.getCons() != null, 3);
- LispError.checkArgument(aEnvironment, aStackTop, pr.car() instanceof String, 3);
- precedence = Integer.parseInt((String) pr.car(), 10);
+ LispError.checkArgument(aEnvironment, aStackTop, precidencePointer.getCons() != null, 3, "INTERNAL");
+ LispError.checkArgument(aEnvironment, aStackTop, precidencePointer.car() instanceof String, 3, "INTERNAL");
+ precedence = Integer.parseInt((String) precidencePointer.car(), 10);
// Finally define the rule base
- aEnvironment.defineRule(Utility.getSymbolName(aEnvironment, orig),
+ if(aPattern == true)
+ {
+ aEnvironment.defineRulePattern(aStackTop, Utility.getSymbolName(aEnvironment, orig),
+ arity,
+ precedence,
+ predicate,
+ bodyPointer);
+ }
+ else
+ {
+ aEnvironment.defineRule(aStackTop, Utility.getSymbolName(aEnvironment, orig),
arity,
precedence,
predicate,
- body);
+ bodyPointer);
+ }
// Return true
Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
}
-
- public static void defMacroRuleBase(Environment aEnvironment, int aStackTop, boolean aListed) throws Exception {
+ public static void defMacroRulebase(Environment aEnvironment, int aStackTop, boolean aListed) throws Exception {
// Get operator
ConsPointer args = new ConsPointer();
ConsPointer body = new ConsPointer();
String orig = null;
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1, "INTERNAL");
orig = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
+ LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1, "INTERNAL");
// The arguments
args.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- LispError.checkIsList(aEnvironment, aStackTop, args, 2);
+ LispError.checkIsList(aEnvironment, aStackTop, args, 2, "INTERNAL");
// Finally define the rule base
- aEnvironment.declareMacroRulebase(Utility.getSymbolName(aEnvironment, orig),
+ aEnvironment.defineMacroRulebase(aStackTop, Utility.getSymbolName(aEnvironment, orig),
((ConsPointer) args.car()).cdr(), aListed);
// Return true
@@ -1210,64 +1250,26 @@
}
- public static void newRulePattern(Environment aEnvironment, int aStackTop, boolean aMacroMode) throws Exception {
- int arity;
- int precedence;
-
- ConsPointer arityPointer = new ConsPointer();
- ConsPointer precedencePointer = new ConsPointer();
- ConsPointer predicatePointer = new ConsPointer();
- ConsPointer bodyPointer = new ConsPointer();
- String orig = null;
-
- // Get operator
- LispError.checkArgument(aEnvironment, aStackTop, BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).getCons() != null, 1);
- orig = (String) BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 1).car();
- LispError.checkArgument(aEnvironment, aStackTop, orig != null, 1);
- arityPointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 2).getCons());
- precedencePointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 3).getCons());
- predicatePointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 4).getCons());
- bodyPointer.setCons(BuiltinFunction.getArgumentPointer(aEnvironment, aStackTop, 5).getCons());
-
- // The arity
- LispError.checkArgument(aEnvironment, aStackTop, arityPointer.getCons() != null, 2);
- LispError.checkArgument(aEnvironment, aStackTop, arityPointer.car() instanceof String, 2);
- arity = Integer.parseInt((String) arityPointer.car(), 10);
-
- // The precedence
- LispError.checkArgument(aEnvironment, aStackTop, precedencePointer.getCons() != null, 3);
- LispError.checkArgument(aEnvironment, aStackTop, precedencePointer.car() instanceof String, 3);
- precedence = Integer.parseInt((String) precedencePointer.car(), 10);
- // Finally define the rule base
- aEnvironment.defineRulePattern(Utility.getSymbolName(aEnvironment, orig),
- arity,
- precedence,
- predicatePointer,
- bodyPointer);
-
- // Return true
- Utility.putTrueInPointer(aEnvironment, BuiltinFunction.getTopOfStackPointer(aEnvironment, aStackTop));
- }
-
-
- public static String dumpRule(Branch branch, Environment aEnvironment, SingleArityBranchingUserFunction userFunction) {
+ public static String dumpRule(int aStackTop, Rule rule, Environment aEnvironment, SingleArityRulebase userFunction) {
StringBuilder dumpResult = new StringBuilder();
try {
- int precedence = branch.getPrecedence();
- ConsPointer predicatePointer1 = branch.getPredicatePointer();
+ int precedence = rule.getPrecedence();
+
+ ConsPointer predicatePointer1 = rule.getPredicatePointer();
String predicate = "";
String predicatePointerString = predicatePointer1.toString();
+
if (predicatePointerString == null || predicatePointerString.equalsIgnoreCase("Empty.")) {
predicate = "None.";
} else {
- predicate = Utility.printExpression(predicatePointer1, aEnvironment, 0);
+ predicate = Utility.printMathPiperExpression(aStackTop, predicatePointer1, aEnvironment, 0);
}
- if (predicate.equalsIgnoreCase("\"Pattern\"")) {
+ if (rule instanceof PatternRule) {
predicate = "(Pattern) ";
- PatternBranch branchPattern = (PatternBranch) branch;
- Pattern pattern = branchPattern.getPattern();
+ PatternRule branchPattern = (PatternRule) rule;
+ ParametersPatternMatcher pattern = branchPattern.getPattern();
Iterator variablesIterator = pattern.getVariables().iterator();
String patternVariables = "";
@@ -1283,9 +1285,10 @@
Iterator parameterMatchersIterator = pattern.getParameterMatchers().iterator();
String parameterTypes = "";
while (parameterMatchersIterator.hasNext()) {
- PatternParameter parameter = (PatternParameter) parameterMatchersIterator.next();
+ PatternParameterMatcher parameter = (PatternParameterMatcher) parameterMatchersIterator.next();
String parameterType = (String) parameter.getType();
- parameterTypes += parameterType + ", ";
+ parameterTypes += parameterType + ": " + parameter.toString();
+ parameterTypes += "; ";
}
if (parameterTypes.contains(",")) {
parameterTypes = parameterTypes.substring(0, parameterTypes.lastIndexOf(","));
@@ -1296,7 +1299,7 @@
Iterator patternPredicatesIterator = pattern.getPredicates().iterator();
while (patternPredicatesIterator.hasNext()) {
ConsPointer predicatePointer = (ConsPointer) patternPredicatesIterator.next();
- String patternPredicate = Utility.printExpression(predicatePointer, aEnvironment, 0);
+ String patternPredicate = Utility.printMathPiperExpression(aStackTop, predicatePointer, aEnvironment, 0);
predicate += patternPredicate + ", ";
}
/*if (predicate.contains(",")) {
@@ -1305,15 +1308,14 @@
predicate += "\n Variables: " + patternVariables + ", ";
predicate += "\n Types: " + parameterTypes;
-
}//end if.
Iterator paremetersIterator = userFunction.getParameters();
String parameters = "";
boolean isHold = false;
while (paremetersIterator.hasNext()) {
- FunctionParameter branchParameter = (FunctionParameter) paremetersIterator.next();
- String parameter = branchParameter.getParameter();
+ ParameterName branchParameter = (ParameterName) paremetersIterator.next();
+ String parameter = branchParameter.getName();
isHold = branchParameter.isHold();
parameters += parameter + ", ";
}
@@ -1321,24 +1323,26 @@
parameters = parameters.substring(0, parameters.lastIndexOf(","));
}
- String body = Utility.printExpression(branch.getBodyPointer(), aEnvironment, 0);
+ String body = Utility.printMathPiperExpression(aStackTop, rule.getBodyPointer(), aEnvironment, 0);
body = body.replace(",", ", ");
//System.out.println(data);
String substitutedMacroBody = "";
- if (userFunction instanceof MacroUserFunction) {
+ if (userFunction instanceof MacroRulebase) {
BackQuoteSubstitute backQuoteSubstitute = new BackQuoteSubstitute(aEnvironment);
ConsPointer substitutedBodyPointer = new ConsPointer();
- Utility.substitute(aEnvironment, substitutedBodyPointer, branch.getBodyPointer(), backQuoteSubstitute);
- substitutedMacroBody = Utility.printExpression(substitutedBodyPointer, aEnvironment, 0);
+ Utility.substitute(aEnvironment, aStackTop, substitutedBodyPointer, rule.getBodyPointer(), backQuoteSubstitute);
+ substitutedMacroBody = Utility.printMathPiperExpression(aStackTop, substitutedBodyPointer, aEnvironment, 0);
}
dumpResult.append("Precedence: " + precedence + ", ");
+ dumpResult.append("\n" + "Rule Type: " + rule.getClass().getSimpleName() + ", ");
+ dumpResult.append("\n" + "Arity: " + userFunction.arity() + ", ");
dumpResult.append("\n" + "Parameters: " + parameters + ", ");
dumpResult.append("\n" + "Predicates: " + predicate + ", ");
- if (userFunction instanceof MacroUserFunction) {
+ if (userFunction instanceof MacroRulebase) {
dumpResult.append("\n" + "Body: \n" + body + ", ");
dumpResult.append("\n" + "Substituted Macro Body: \n" + substitutedMacroBody + "\n");
} else {
@@ -1354,8 +1358,7 @@
}//end method.
-
- public static Cons associativeListGet(Environment aEnvironment, ConsPointer key, Cons listCons) throws Exception {
+ public static Cons associativeListGet(Environment aEnvironment, int aStackTop, ConsPointer key, Cons listCons) throws Exception {
while (listCons != null) {
@@ -1365,7 +1368,7 @@
sub = sub.cdr().getCons();
ConsPointer temp = new ConsPointer();
temp.setCons(sub);
- if (Utility.equals(aEnvironment, key, temp)) {
+ if (Utility.equals(aEnvironment, aStackTop, key, temp)) {
return listCons;
}//end if.
@@ -1380,6 +1383,139 @@
return null;
}//end method.
+ /**
+ * Returns the type of a.
+ * @param aEnvironment
+ * @param expressionPointer
+ * @throws java.lang.Exception
+ */
+ public static String functionType(ConsPointer expressionPointer) throws Exception {
+ if (!(expressionPointer.car() instanceof ConsPointer)) {
+ return "";
+ }
+
+ ConsPointer subList = (ConsPointer) expressionPointer.car();
+ Cons head = null;
+ head = subList.getCons();
+ if (!(head.car() instanceof String)) {
+ return "";
+ }//end if.
+
+ return (String) head.car();
+
+ }//end method.
+
+ /**
+ * Converts a =Java Iterable into a MathPiper List.
+ *
+ * @param aEnvironment
+ * @param iterable
+ * @return cons
+ * @throws java.lang.Exception
+ */
+ public static Cons iterableToList(Environment aEnvironment, int aStackTop, java.lang.Iterable iterable) throws Exception {
+
+ Cons head = aEnvironment.iListAtom.copy(aEnvironment, false);
+
+ ConsPointer consPointer = new ConsPointer();
+
+ consPointer.setCons(head);
+
+ Iterator iterator = iterable.iterator();
+
+ while (iterator.hasNext()) {
+ Object object = iterator.next();
+
+ if(object instanceof String)
+ {
+ String key = (String) object;
+
+ Cons stringCons = AtomCons.getInstance(aEnvironment, aStackTop, key);
+
+ consPointer.getCons().cdr().setCons(stringCons);
+ }
+ else
+ {
+ consPointer.getCons().cdr().setCons(BuiltinObjectCons.getInstance(aEnvironment, aStackTop, new JavaObject(object)));
+ }
+
+ consPointer.goNext(aStackTop, aEnvironment);
+
+ }//end while.
+
+ return head;
+
+ }//end method.
+
+
+ public static ConsPointer mathPiperParse(Environment aEnvironment, int aStackTop, String inputExpression) throws Exception {
+ MathPiperTokenizer tokenizer = new MathPiperTokenizer();
+ InputStatus someStatus = new InputStatus();
+ ConsPointer inputExpressionPointer = new ConsPointer();
+
+ StringBuffer inp = new StringBuffer();
+ inp.append(inputExpression);
+ inp.append(";");
+ StringInputStream inputExpressionBuffer = new StringInputStream(inp, someStatus);
+
+ Parser infixParser = new MathPiperParser(tokenizer, inputExpressionBuffer, aEnvironment, aEnvironment.iPrefixOperators, aEnvironment.iInfixOperators, aEnvironment.iPostfixOperators, aEnvironment.iBodiedOperators);
+ infixParser.parse(aStackTop, inputExpressionPointer);
+
+ return inputExpressionPointer;
+ }//end method.
+
+
+
+
+ public static ConsPointer lispEvaluate(Environment aEnvironment, int aStackTop, String inputExpression) throws Exception {
+ ConsPointer result = new ConsPointer();
+
+ ConsPointer inputExpressionPointer = mathPiperParse(aEnvironment, aStackTop, inputExpression);
+
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, result, inputExpressionPointer);
+
+ return result;
+ }//end method.
+
+
+
+
+ public static ConsPointer lispEvaluate(Environment aEnvironment, int aStackTop, ConsPointer inputExpressionPointer) throws Exception {
+ ConsPointer result = new ConsPointer();
+ MathPiperTokenizer tokenizer = new MathPiperTokenizer();
+ InputStatus someStatus = new InputStatus();
+
+ aEnvironment.iLispExpressionEvaluator.evaluate(aEnvironment, aStackTop, result, inputExpressionPointer);
+
+ return result;
+ }//end method.
+
+
+
+ public static void declareFunction(String functionName, String[] parameters, String body, Environment aEnvironment, int aStackTop) throws Exception
+ {
+
+ ConsTraverser parameterTraverser = new ConsTraverser(aEnvironment, new ConsPointer());
+
+ for(String parameterName:parameters)
+ {
+ Cons atomCons = AtomCons.getInstance(aEnvironment, aStackTop, parameterName);
+
+ parameterTraverser.setCons(atomCons);
+
+ parameterTraverser.goNext(aStackTop);
+ }//end for.
+
+ aEnvironment.defineRulebase(aStackTop, functionName, parameterTraverser.getHeadPointer(), false);
+
+ ConsPointer truePointer = new ConsPointer();
+
+ Utility.putTrueInPointer(aEnvironment, truePointer);
+
+ ConsPointer expressionPointer = Utility.mathPiperParse(aEnvironment, aStackTop, body);
+
+ aEnvironment.defineRule(aStackTop, functionName, parameters.length, 100, truePointer, expressionPointer);
+ }
}//end class.
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/array/ArrayCreateFromList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/array/ArrayCreateFromList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/array/ArrayCreateFromList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/array/ArrayCreateFromList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-
-%mathpiper,def="ArrayCreateFromList"
-
-ArrayCreateFromList(list):=
-[
- Local(result,i);
- result:=ArrayCreate(Length(list),0);
- i:=1;
- While (list != {})
- [
- result[i]:=First(list);
- i++;
- list:=Rest(list);
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="ArrayCreateFromList",categories="Programmer Functions;Native Objects"
-*CMD ArrayCreateFromList --- convert list to array
-*CALL
- ArrayCreateFromList(list)
-
-*DESC
-Creates an array from the contents of the list passed in.
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/array/ArrayToList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/array/ArrayToList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/array/ArrayToList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/array/ArrayToList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="ArrayToList"
-
-ArrayToList(array):= (array[1 .. ArraySize(array) ]);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="ArrayToList",categories="Programmer Functions;Native Objects"
-*CMD ArrayToList --- convert array to list
-*CORE
-*CALL
- ArrayToList(array)
-
-*DESC
-Creates a list from the contents of the array passed in.
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/AssocDelete.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/AssocDelete.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/AssocDelete.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/AssocDelete.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,95 +0,0 @@
-%mathpiper,def="AssocDelete"
-
-/// Delete an element of an associative list.
-LocalSymbols(hash, key, element, hash'expr)
-[
-
-/// AssocDelete(hash,{"key", value})
-10 # AssocDelete(hash_IsList, element_IsList) <--
-[
- Local(index);
- index := Find(hash, element);
- If(
- index > 0,
- DestructiveDelete(hash, index)
- );
- index>0; // return False if nothing found
-
-];
-
-
-/// AssocDelete(hash, "key")
-20 # AssocDelete(hash_IsList, key_IsString) <--
-[
- AssocDelete(hash, Builtin'Assoc(key, hash));
-];
-
-30 # AssocDelete(hash_IsList, Empty) <-- False;
-
-//HoldArg("AssocDelete", hash);
-//UnFence("AssocDelete", 1);
-//UnFence("AssocDelete", 2);
-
-]; // LocalSymbols(hash, ...)
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="AssocDelete",categories="User Functions;Lists (Operations)"
-*CMD AssocDelete --- delete an entry in an association list
-*STD
-*CALL
- AssocDelete(alist, "key")
- AssocDelete(alist, {key, value})
-
-*PARMS
-
-{alist} -- association list
-
-{"key"} -- string, association key
-
-{value} -- value of the key to be deleted
-
-*DESC
-
-The key {"key"} in the association list {alist} is deleted. (The list itself is modified.) If the key was found and successfully deleted, returns {True}, otherwise if the given key was not found, the function returns {False}.
-
-The second, longer form of the function deletes the entry that has both the
-specified key and the specified value. It can be used for two purposes:
-* 1. to make sure that we are deleting the right value;
-* 2. if several values are stored on the same key, to delete the specified entry (see the last example).
-
-At most one entry is deleted.
-
-*E.G.
-
- In> writer := {};
- Out> {};
- In> writer["Iliad"] := "Homer";
- Out> True;
- In> writer["Henry IV"] := "Shakespeare";
- Out> True;
- In> writer["Ulysses"] := "James Joyce";
- Out> True;
- In> AssocDelete(writer, "Henry IV")
- Out> True;
- In> AssocDelete(writer, "Henry XII")
- Out> False;
- In> writer
- Out> {{"Ulysses","James Joyce"},
- {"Iliad","Homer"}};
- In> DestructiveAppend(writer,
- {"Ulysses", "Dublin"});
- Out> {{"Iliad","Homer"},{"Ulysses","James Joyce"},
- {"Ulysses","Dublin"}};
- In> writer["Ulysses"];
- Out> "James Joyce";
- In> AssocDelete(writer,{"Ulysses","James Joyce"});
- Out> True;
- In> writer
- Out> {{"Iliad","Homer"},{"Ulysses","Dublin"}};
-
-
-*SEE Assoc, AssocIndices
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/AssocIndices.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/AssocIndices.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/AssocIndices.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/AssocIndices.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="AssocIndices"
-
-AssocIndices(associndiceslist_IsList) <--
- DestructiveReverse(MapSingle("First",associndiceslist));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="AssocIndices",categories="User Functions;Lists (Operations)"
-*CMD AssocIndices --- return the keys in an association list
-*STD
-*CALL
- AssocIndices(alist)
-
-*PARMS
-
-{alist} -- association list to examine
-
-*DESC
-
-All the keys in the association list "alist" are assembled in a list
-and this list is returned.
-
-*E.G.
-
- In> writer := {};
- Out> {};
- In> writer["Iliad"] := "Homer";
- Out> True;
- In> writer["Henry IV"] := "Shakespeare";
- Out> True;
- In> writer["Ulysses"] := "James Joyce";
- Out> True;
- In> AssocIndices(writer);
- Out> {"Iliad","Henry IV","Ulysses"};
-
-*SEE Assoc, AssocDelete
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/Assoc.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/Assoc.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/assoc/Assoc.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/assoc/Assoc.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="Assoc"
-
-/* Assoc : given an assoc list like for example l:={{a,2},{b,3}},
- Assoc(b,l) will return {b,3}. if the key is not in the list,
- it will return the atom Empty.
-*/
-
-Function("Assoc",{key,list}) Builtin'Assoc(key,list);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Assoc",categories="User Functions;Lists (Operations)"
-*CMD Assoc --- return element stored in association list
-*STD
-*CALL
- Assoc(key, alist)
-
-*PARMS
-
-{key} -- string, key under which element is stored
-
-{alist} -- association list to examine
-
-*DESC
-
-The association list "alist" is searched for an entry stored with
-index "key". If such an entry is found, it is returned. Otherwise
-the atom {Empty} is returned.
-
-Association lists are represented as a list of two-entry lists. The
-first element in the two-entry list is the key, the second element is
-the value stored under this key.
-
-The call {Assoc(key, alist)} can (probably more
-intuitively) be accessed as {alist[key]}.
-
-*E.G.
-
- In> writer := {};
- Out> {};
- In> writer["Iliad"] := "Homer";
- Out> True;
- In> writer["Henry IV"] := "Shakespeare";
- Out> True;
- In> writer["Ulysses"] := "James Joyce";
- Out> True;
- In> Assoc("Henry IV", writer);
- Out> {"Henry IV","Shakespeare"};
- In> Assoc("War and Peace", writer);
- Out> Empty;
-
-*SEE AssocIndices, [], :=, AssocDelete
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/CosN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/CosN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/CosN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/CosN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-%mathpiper,def="CosN"
-
-Defun("CosN",{x})Trigonometry(x,0.0,1.0,1.0);
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="CosN",categories="User Functions;Numeric"
-*CMD CosN --- cosine (arbitrary-precision math function)
-*CALL
- CosN(x)
-
-*DESC
-
-This command performs the calculation of an elementary mathematical
-function. The arguments must be numbers. The reason for the
-postfix {N} is that the library needs to define equivalent non-numerical
-functions for symbolic computations, such as {Exp}, {Sin}, etc.
-
-Note that all xxxN functions accept integers as well as floating-point numbers.
-The resulting values may be integers or floats. If the mathematical result is an
-exact integer, then the integer is returned. For example, {Sqrt(25)} returns
-the integer {5}, and {Power(2,3)} returns the integer {8}. In such cases, the
-integer result is returned even if the calculation requires more digits than set by
-{BuiltinPrecisionSet}. However, when the result is mathematically not an integer,
-the functions return a floating-point result which is correct only to the current precision.
-
-*E.G.
- In>
- Result>
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/ExpN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/ExpN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/ExpN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/ExpN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="ExpN"
-
-/// ExpN(x). Algorithm: for x<0, divide 1 by ExpN(-x); for x>1, compute ExpN(x/2)^2 recursively; for 0must be numbers. The reason for the
-postfix {N} is that the library needs to define equivalent non-numerical
-functions for symbolic computations, such as {Exp}, {Sin}, etc.
-
-Note that all xxxN functions accept integers as well as floating-point numbers.
-The resulting values may be integers or floats. If the mathematical result is an
-exact integer, then the integer is returned. For example, {Sqrt(25)} returns
-the integer {5}, and {Power(2,3)} returns the integer {8}. In such cases, the
-integer result is returned even if the calculation requires more digits than set by
-{BuiltinPrecisionSet}. However, when the result is mathematically not an integer,
-the functions return a floating-point result which is correct only to the current precision.
-
-*E.G.
- In>
- Result>
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathExpDoubling.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathExpDoubling.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathExpDoubling.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathExpDoubling.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-%mathpiper,def="MathExpDoubling",scope="private"
-
-/// Identity transformation, compute Exp(x) from value=Exp(x/2^n) by squaring the value n times
-Defun("MathExpDoubling", {value, n})
-[
- Local(shift, result);
- Set(shift, n);
- Set(result, value);
- While (GreaterThan(shift,0)) // will lose 'shift' bits of precision here
- [
- Set(result, MultiplyN(result, result));
- Set(shift, AddN(shift,MathNegate(1)));
- ];
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathExpTaylor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathExpTaylor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathExpTaylor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathExpTaylor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,30 +0,0 @@
-%mathpiper,def="MathExpTaylor",scope="private"
-
-// simple Taylor expansion, use only for 0<=x<1
-Defun("MathExpTaylor0",{x})
-[
- Local(i,aResult,term,eps);
- // Exp(x)=Sum(i=0 to Inf) x^(i) /(i)!
- // Which incrementally becomes the algorithm:
- //
- // i <- 0
- Set(i,0);
- // sum <- 1
- Set(aResult,1.0);
- // term <- 1
- Set(term,1.0);
- Set(eps,MathIntPower(10,MathNegate(BuiltinPrecisionGet())));
- // While (term>epsilon)
- While(GreaterThan(AbsN(term),eps))
- [
- // i <- i+1
- Set(i,AddN(i,1));
- // term <- term*x/(i)
- Set(term,DivideN(MultiplyN(term,x),i));
- // sum <- sum+term
- Set(aResult,AddN(aResult,term));
- ];
- aResult;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathFloatPower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathFloatPower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathFloatPower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathFloatPower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,12 +0,0 @@
-%mathpiper,def="MathFloatPower",scope="private"
-
-// power function for non-integer argument y -- use ExpN and LogN
-/* Serge, I disabled this one for now, until we get a compiled version of LogN that does not hang in
- an infinite loop. The C++ version of LogN never terminates, so I mapped LogN to your Internal'LnNum
- which of course does a much better job of it. Corollary is that this function can be defined when we also
- have Internal'LnNum in this file.
-Defun("MathFloatPower", {x,y})
- If(IsInteger(y), False, ExpN(MultiplyN(y,LogN(x))));
-*/
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathIntPower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathIntPower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathIntPower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathIntPower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-%mathpiper,def="MathIntPower",scope="private"
-
-// power x^y only for integer y (perhaps negative)
-Defun("MathIntPower", {x,y})
- If(Equals(x,0),0,If(Equals(x,1),1,
- If(IsInteger(y),If(LessThan(y,0), // negative power, need to convert x to float to save time, since x^(-n) is never going to be integer anyway
- DivideN(1, PositiveIntPower(AddN(x,0.),MathNegate(y))),
- // now the positive integer y calculation - note that x might still be integer
- PositiveIntPower(x,y)
- ), // floating-point calculation is absent, return False
- False)
- ));
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathMul2Exp.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathMul2Exp.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathMul2Exp.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathMul2Exp.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-%mathpiper,def="MathMul2Exp"
-
-// MathMul2Exp: multiply x by 2^n quickly (for integer n)
-// this should really be implemented in the core as a call to BigNumber::ShiftRight or ShiftLeft
-Defun("MathMul2Exp", {x,n}) // avoid roundoff by not calculating 1/2^n separately
- If(GreaterThan(n,0), MultiplyN(x, MathIntPower(2,n)), DivideN(x, MathIntPower(2,MathNegate(n))));
-// this doesn't work because ShiftLeft/Right don't yet work on floats
-// If(GreaterThan(n,0), ShiftLeft(x,n), ShiftRight(x,n)
-// );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathPi.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathPi.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/MathPi.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/MathPi.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="MathPi"
-
-Defun("MathPi",{})
-[
- // Newton's method for finding pi:
- // x[0] := 3.1415926
- // x[n+1] := x[n] + Sin(x[n])
- Local(initialPrec,curPrec,result,aPrecision);
- Set(aPrecision,BuiltinPrecisionGet());
- Set(initialPrec, aPrecision); // target precision of first iteration, will be computed below
- Set(curPrec, 40); // precision of the initial guess
- Set(result, 3.141592653589793238462643383279502884197169399); // initial guess
-
- // optimize precision sequence
- While (GreaterThan(initialPrec, MultiplyN(curPrec,3)))
- [
- Set(initialPrec, FloorN(DivideN(AddN(initialPrec,2),3)));
- ];
- Set(curPrec, initialPrec);
- While (Not(GreaterThan(curPrec, aPrecision)))
- [
- // start of iteration code
- // Get Sin(result)
- BuiltinPrecisionSet(curPrec);
- Set(result,AddN(result,SinN(result)));
- // Calculate new result: result := result + Sin(result);
- // end of iteration code
- // decide whether we are at end of loop now
- If (Equals(curPrec, aPrecision), // if we are exactly at full precision, it's the last iteration
- [
- Set(curPrec, AddN(aPrecision,1)); // terminate loop
- ],
- [
- Set(curPrec, MultiplyN(curPrec,3)); // precision triples at each iteration
- // need to guard against overshooting precision
- If (GreaterThan(curPrec, aPrecision),
- [
- Set(curPrec, aPrecision); // next will be the last iteration
- ]);
- ]);
- ];
- BuiltinPrecisionSet(aPrecision);
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/PositiveIntPower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/PositiveIntPower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/PositiveIntPower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/PositiveIntPower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="PositiveIntPower",scope="private"
-
-// first define the binary exponentiation algorithm, MathIntPower.
-// Later, the PowerN function will be defined through IntPower and MathLn/ExpN. Note that ExpN uses IntPower.
-
-// power x^n only for non-negative integer n
-Defun("PositiveIntPower", {x,n})
-[
- Local(result,unit);
- If(LessThan(n,0), False,
- [
- Set(unit,1); // this is a constant, initial value of the power
- Set(result, unit);
- If(Equals(n,0),unit,
- If(Equals(n,1),x,
- [
- While(GreaterThan(n,0))
- [
- If(
- Equals(BitAnd(n,1), 1),
-// If(
-// Equals(result,unit), // if result is already assigned
-// Set(result, x), // avoid multiplication
- Set(result, MultiplyN(result,x))
-// )
- );
- Set(x, MultiplyN(x,x));
- Set(n,ShiftRight(n,1));
- ];
- result;
- ]
- )
- );
- ]);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/PowerN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/PowerN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/PowerN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/PowerN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,48 +0,0 @@
-%mathpiper,def="PowerN"
-
-// power function that works for all real x, y
-/// FIXME: No precision tracking yet.
-
-/* Serge, as MathFloatPower cannot be defined yet, I made the "avoid PowerN(num,float) explicit :-)
-*/
-Defun("PowerN", {x,y})
-// avoid PowerN(0,float)
- If(Equals(x,0),0, If(Equals(x,1),1,
- If(IsInteger(y), MathIntPower(x,y), False/*MathFloatPower(x,y)*/)
- ));
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="PowerN",categories="User Functions;Numeric"
-*CMD PowerN --- power x^y (arbitrary-precision math function)
-*CALL
- PowerN(x,y)
-
-*DESC
-
-This command performs the calculation of an elementary mathematical
-function. The arguments must be numbers. The reason for the
-postfix {N} is that the library needs to define equivalent non-numerical
-functions for symbolic computations, such as {Exp}, {Sin}, etc.
-
-Note that all xxxN functions accept integers as well as floating-point numbers.
-The resulting values may be integers or floats. If the mathematical result is an
-exact integer, then the integer is returned. For example, {Sqrt(25)} returns
-the integer {5}, and {Power(2,3)} returns the integer {8}. In such cases, the
-integer result is returned even if the calculation requires more digits than set by
-{BuiltinPrecisionSet}. However, when the result is mathematically not an integer,
-the functions return a floating-point result which is correct only to the current precision.
-
-*E.G.
- In> BuiltinPrecisionSet(10)
- Out> True
- In> PowerN(2,3)
- Out> 8
- In> PowerN(2,-3)
- Out> 0.125
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/SinN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/SinN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/SinN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/SinN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-%mathpiper,def="SinN"
-
-Defun("SinN",{x})Trigonometry(x,1.0,x,x);
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="SinN",categories="User Functions;Numeric"
-*CMD SinN --- sine (arbitrary-precision math function)
-*CALL
- SinN(x)
-
-*DESC
-
-This command performs the calculation of an elementary mathematical
-function. The arguments must be numbers. The reason for the
-postfix {N} is that the library needs to define equivalent non-numerical
-functions for symbolic computations, such as {Exp}, {Sin}, etc.
-
-Note that all xxxN functions accept integers as well as floating-point numbers.
-The resulting values may be integers or floats. If the mathematical result is an
-exact integer, then the integer is returned. For example, {Sqrt(25)} returns
-the integer {5}, and {Power(2,3)} returns the integer {8}. In such cases, the
-integer result is returned even if the calculation requires more digits than set by
-{BuiltinPrecisionSet}. However, when the result is mathematically not an integer,
-the functions return a floating-point result which is correct only to the current precision.
-
-*E.G.
- In>
- Result>
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/TanN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/TanN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/TanN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/TanN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-%mathpiper,def="TanN"
-
-Defun("TanN",{x})DivideN(SinN(x),CosN(x));
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="TanN",categories="User Functions;Numeric"
-*CMD TanN --- tangent (arbitrary-precision math function)
-*CALL
- TanN(x)
-
-*DESC
-
-This command performs the calculation of an elementary mathematical
-function. The arguments must be numbers. The reason for the
-postfix {N} is that the library needs to define equivalent non-numerical
-functions for symbolic computations, such as {Exp}, {Sin}, etc.
-
-Note that all xxxN functions accept integers as well as floating-point numbers.
-The resulting values may be integers or floats. If the mathematical result is an
-exact integer, then the integer is returned. For example, {Sqrt(25)} returns
-the integer {5}, and {Power(2,3)} returns the integer {8}. In such cases, the
-integer result is returned even if the calculation requires more digits than set by
-{BuiltinPrecisionSet}. However, when the result is mathematically not an integer,
-the functions return a floating-point result which is correct only to the current precision.
-
-*E.G.
- In>
- Result>
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/Trigonometry.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/Trigonometry.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/base/Trigonometry.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/base/Trigonometry.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-%mathpiper,def="Trigonometry",scope="private"
-
-Defun("Trigonometry",{x,i,sum,term})
-[
- Local(x2,orig,eps,previousPrec,newPrec);
- Set(previousPrec,BuiltinPrecisionGet());
- Set(newPrec,AddN(BuiltinPrecisionGet(),2));
- Set(x2,MultiplyN(x,x));
- BuiltinPrecisionSet(newPrec);
- Set(eps,MathIntPower(10,MathNegate(previousPrec)));
- While(GreaterThan(AbsN(term),eps))
- [
- Set(term,MultiplyN(term,x2));
- Set(i,AddN(i,1.0));
- Set(term,DivideN(term,i));
- Set(i,AddN(i,1.0));
- Set(term,DivideN(MathNegate(term),i));
- BuiltinPrecisionSet(previousPrec);
- Set(sum, AddN(sum, term));
- BuiltinPrecisionSet(newPrec);
- ];
- BuiltinPrecisionSet(previousPrec);
- sum;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/c_form/CForm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/c_form/CForm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/c_form/CForm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/c_form/CForm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,251 +0,0 @@
-%mathpiper,def="CForm"
-
-/* CForm: convert MathPiper objects to C/C++ code. */
-
-/* version 0.3 */
-
-/* Changelog
- 0.1 CForm() derived from TeXForm() v0.4. Have basic functionality. Do not allow list manipulation, unevaluated derivatives, set operations, limits, integrals, Infinity, explicit matrices. Complex numbers and expressions are handled just like real ones. Indexed symbols are assumed to be arrays and handled literally. No declarations or prototypes are supplied. Function definitions are not handled. Sum() is left as is (can be defined as a C function).
- 0.2 Fix for extra parens in Sin() and other functions; fixes for Exp(), Abs() and inverse trig functions
- 0.3 Fix for indexed expressions: support a[2][3][4]
- 0.3.1 Fix for CForm(integer): add a decimal point
- 0.4 Support While()[]. Added IsCFormable. Use Concat() instead of Union() on lists.
- 0.4.1 Support False, True
- 0.4.2 Changed it so that integers are not coerced to floats any more automatically (one can coerce integers to floats manually nowadays by adding a decimal point to the string representation, eg. 1. instead of 1).
-*/
-
-/* To do:
- 0. Find and fix bugs.
- 1. Chop strings that are longer than 80 chars?
- 2. Optimization of C code?
-*/
-
-RuleBase("CForm",{expression});
-RuleBase("CForm",{expression, precedence});
-
-Function ("CFormBracketIf", {predicate, string})
-[
- Check(IsBoolean(predicate) And IsString(string), "CForm internal error: non-boolean and/or non-string argument of CFormBracketIf");
- If(predicate, ConcatStrings("( ", string, ") "), string);
-];
-
-/* Proceed just like TeXForm()
-*/
-
-// CFormMaxPrec should perhaps only be used from within this file, it is thus not in the .def file.
-CFormMaxPrec() := 60000; /* This precedence will never be bracketed. It is equal to KMaxPrec */
-
-100 # CForm(_x) <-- CForm(x, CFormMaxPrec());
-
-/* Replace numbers and variables -- never bracketed except explicitly */
-110 # CForm(x_IsInteger, _p) <-- String(x);
-111 # CForm(x_IsZero, _p) <-- "0.";
-112 # CForm(x_IsNumber, _p) <-- String(x);
-/* Variables are left as is, except some special ones */
-190 # CForm(False, _p) <-- "false";
-190 # CForm(True, _p) <-- "true";
-200 # CForm(x_IsAtom, _p) <-- String(x);
-
-/* Strings must be quoted but not bracketed */
-100 # CForm(x_IsString, _p) <-- ConcatStrings("\"", x, "\"");
-
-/* Replace operations */
-
-/* arithmetic */
-
-/* addition, subtraction, multiplication, all comparison and logical operations are "regular" */
-
-
-LocalSymbols(cformRegularOps) [
- cformRegularOps := { {"+"," + "}, {"-"," - "}, {"*"," * "},
- {"/"," / "}, {":="," = "}, {"=="," == "},
- {"="," == "}, {"!="," != "}, {"<="," <= "},
- {">="," >= "}, {"<"," < "}, {">"," > "},
- {"And"," && "}, {"Or"," || "}, {">>", " >> "},
- { "<<", " << " }, { "&", " & " }, { "|", " | " },
- { "%", " % " }, { "^", " ^ " },
- };
-
- CFormRegularOps() := cformRegularOps;
-]; // LocalSymbols(cformRegularOps)
-
- /* This is the template for "regular" binary infix operators:
-100 # CForm(_x + _y, _p) <-- CFormBracketIf(p CForm(Sin(a1)+2*Cos(b1));
- Out> "sin(a1) + 2 * cos(b1)";
-
-*SEE PrettyForm, TeXForm, IsCFormable
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/c_form/IsCFormable.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/c_form/IsCFormable.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/c_form/IsCFormable.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/c_form/IsCFormable.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,98 +0,0 @@
-%mathpiper,def="IsCFormable"
-
-//////////////////////////////////////////////////
-/// IsCFormable
-//////////////////////////////////////////////////
-
-LocalSymbols(CFormAllFunctions) [
-
- /// predicate to test whether an expression can be successfully exported to C code
-
- /// interface with empty extra function list
- // need the backquote stuff b/c we have HoldArg now
- IsCFormable(_expr) <-- `IsCFormable(@expr, {});
-
- // need to check that expr contains only allowed functions
- IsCFormable(_expr, funclist_IsList) <--
- [
- Local(bad'functions);
- bad'functions := Difference(`FuncList(@expr), Concat(CFormAllFunctions, funclist));
- If(Length(bad'functions)=0,
- True,
- [
- If(InVerboseMode(),
- Echo(Concat({"IsCFormable: Info: unexportable function(s): "}, bad'functions))
- );
- False;
- ]
- );
- ];
- HoldArgNr("IsCFormable", 1, 1);
- HoldArgNr("IsCFormable", 2, 1);
-
- /// This is a list of all function atoms which CForm can safely handle
- CFormAllFunctions := MapSingle(Atom, Concat(AssocIndices(CFormMathFunctions()), AssocIndices(CFormRegularOps()),
- // list of "other" (non-math) functions supported by CForm: needs to be updated when CForm is extended to handle new functions
- {
- "For",
- "While",
- "Prog",
- "Nth",
- "Mod",
- "Complex",
- "if",
- "else",
- "++",
- "--",
- }
- ));
-
-
-]; // LocalSymbols(CFormAllFunctions)
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsCFormable",categories="User Functions;Input/Output;Predicates"
-*CMD IsCFormable --- check possibility to export expression to C++ code
-*STD
-*CALL
- IsCFormable(expr)
- IsCFormable(expr, funclist)
-
-*PARMS
-
-{expr} -- expression to be exported (this argument is not evaluated)
-
-{funclist} -- list of "allowed" function atoms
-
-*DESC
-
-{IsCFormable} returns {True} if the MathPiper expression {expr} can be exported
-into C++ code. This is a check whether the C++ exporter {CForm} can be safely
-used on the expression.
-
-A MathPiper expression is considered exportable if it contains only functions that can be translated into C++ (e.g. {UnList} cannot be exported). All variables and constants are considered exportable.
-
-The verbose option prints names of functions that are not exportable.
-
-The second calling format of {IsCFormable} can be used to "allow" certain function names that will be available in the C++ code.
-
-*E.G. notest
-
- In> IsCFormable(Sin(a1)+2*Cos(b1))
- Out> True;
- In> V(IsCFormable(1+func123(b1)))
- IsCFormable: Info: unexportable function(s):
- func123
- Out> False;
-This returned {False} because the function {func123} is not available in C++. We can
-explicitly allow this function and then the expression will be considered
-exportable:
-
- In> IsCFormable(1+func123(b1), {func123})
- Out> True;
-
-*SEE CForm, V
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/combinatorics/Combinations.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/combinatorics/Combinations.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/combinatorics/Combinations.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/combinatorics/Combinations.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-%mathpiper,def="Combinations;BinomialCoefficient"
-
-/* Binomials -- now using partial factorial for speed */
-// BinomialCoefficient(n,m) = BinomialCoefficient(n, n-m)
-10 # BinomialCoefficient(0,0) <-- 1;
-10 # BinomialCoefficient(n_IsPositiveInteger,m_IsNonNegativeInteger)_(2*m <= n) <-- ((n-m+1) *** n) / m!;
-15 # BinomialCoefficient(n_IsPositiveInteger,m_IsNonNegativeInteger)_(2*m > n And m <= n) <-- BinomialCoefficient(n, n-m);
-20 # BinomialCoefficient(n_IsInteger,m_IsInteger) <-- 0;
-
-Combinations(n,m) := BinomialCoefficient(n,m);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Combinations;BinomialCoefficient",categories="User Functions;Combinatorics"
-*CMD Combinations/BinomialCoefficient --- combinations/ binomial coefficient
-*STD
-*CALL
- Combinations(n, r)
- BinomialCoefficient(n, r)
-
-*PARMS
-
-{n} -- integer - total number of objects
-{r} -- integer - number of objects chosen
-
-*DESC
-
-These functions are actually two names for a single function.
-
-In combinatorics, the function is thought of as being the number of ways
-to choose "r" objects out of a total of "n" objects if order is
-not taken into account.
-
-In mathematics the function is called the binomial coefficient function
-and it is thought of as the coefficient of the x^r term in the polynomial expansion
-of the binomial power (1 + x)^n.
-
-The binomial coefficient is defined to be zero
-if "r" is negative or greater than "n"; {BinomialCoefficient(0,0)}=1.
-
-
-*E.G.
-
- In> Combinations(10, 4)
- Out> 210;
-
- In> BinomialCoefficient(10, 4)
- Out> 210;
-
-
-*SEE CombinationsAll, Permutations, PermutationsAll, !, Eulerian
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/combinatorics/PermutationsList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/combinatorics/PermutationsList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/combinatorics/PermutationsList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/combinatorics/PermutationsList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,59 +0,0 @@
-%mathpiper,def="PermutationsList"
-
-Function("PermutationsList",{result,list})
-[
- If (Length(list) = 0,
- [
- result;
- ],
- [
- Local(head);
- Local(newresult);
- Local(i);
- head:=list[1];
- newresult:={};
- ForEach(item,result)
- [
- For(i:=Length(item)+1,i>0,i--)
- [
- DestructiveInsert(newresult,1,Insert(item,i,head));
- ];
- ];
- newresult:=DestructiveReverse(newresult);
- PermutationsList(newresult,Rest(list));
- ]);
-];
-
-
-Function("PermutationsList",{list})
-[
- PermutationsList({{}},list);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PermutationsList",categories="User Functions;Combinatorics"
-*CMD PermutationsList --- get all permutations of a list
-*STD
-*CALL
- PermutationsList(list)
-
-*PARMS
-
-{list} -- a list of elements
-
-*DESC
-
-PermutationsList returns a list with all the permutations of
-the original list.
-
-*E.G.
-
- In> PermutationsList({a,b,c})
- Out> {{a,b,c},{a,c,b},{c,a,b},{b,a,c},
- {b,c,a},{c,b,a}};
-
-*SEE Permutations, Combinations, CombinationsAll, LeviCivita
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Arg.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Arg.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Arg.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Arg.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="Arg"
-
-10 # Arg(Complex(Cos(_x),Sin(_x))) <-- x;
-10 # Arg(x_IsZero) <-- Undefined;
-15 # Arg(x_IsPositiveReal) <-- 0;
-15 # Arg(x_IsNegativeReal) <-- Pi;
-20 # Arg(Complex(r_IsZero,i_IsConstant)) <-- Sign(i)*Pi/2;
-30 # Arg(Complex(r_IsPositiveReal,i_IsConstant)) <-- ArcTan(i/r);
-40 # Arg(Complex(r_IsNegativeReal,i_IsPositiveReal)) <-- Pi+ArcTan(i/r);
-50 # Arg(Complex(r_IsNegativeReal,i_IsNegativeReal)) <-- ArcTan(i/r)-Pi;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Arg",categories="User Functions;Numbers (Complex)"
-*CMD Arg --- argument of a complex number
-*STD
-*CALL
- Arg(x)
-
-*PARMS
-
-{x} -- argument to the function
-
-*DESC
-
-This function returns the argument of "x". The argument is the angle
-with the positive real axis in the Argand diagram, or the angle
-"phi" in the polar representation $r * Exp(I*phi)$ of "x". The
-result is in the range ($-Pi$, $Pi$], that is, excluding $-Pi$ but including $Pi$. The
-argument of 0 is {Undefined}.
-
-*E.G.
-
- In> Arg(2)
- Out> 0;
- In> Arg(-1)
- Out> Pi;
- In> Arg(1+I)
- Out> Pi/4;
-
-*SEE Abs, Sign
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Complex.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Complex.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Complex.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Complex.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,140 +0,0 @@
-%mathpiper,def="Complex"
-
-0 # Complex(_r,i_IsZero) <-- r;
-2 # Complex(Complex(_r1,_i1),_i2) <-- Complex(r1,i1+i2);
-2 # Complex(_r1,Complex(_r2,_i2)) <-- Complex(r1-i2,r2);
-
-6 # Complex(Undefined,_x) <-- Undefined;
-6 # Complex(_x,Undefined) <-- Undefined;
-
-
-/* Addition */
-
-110 # Complex(_r1,_i1) + Complex(_r2,_i2) <-- Complex(r1+r2,i1+i2);
-300 # Complex(_r,_i) + x_IsConstant <-- Complex(r+x,i);
-300 # x_IsConstant + Complex(_r,_i) <-- Complex(r+x,i);
-
-110 # - Complex(_r,_i) <-- Complex(-r,-i);
-
-300 # Complex(_r,_i) - x_IsConstant <-- Complex(r-x,i);
-300 # x_IsConstant - Complex(_r,_i) <-- Complex((-r)+x,-i);
-111 # Complex(_r1,_i1) - Complex(_r2,_i2) <-- Complex(r1-r2,i1-i2);
-
-/* Multiplication */
-110 # Complex(_r1,_i1) * Complex(_r2,_i2) <-- Complex(r1*r2-i1*i2,r1*i2+r2*i1);
-/* right now this is slower than above
-110 # Complex(_r1,_i1) * Complex(_r2,_i2) <--
-[ // the Karatsuba trick
- Local(A,B);
- A:=r1*r2;
- B:=i1*i2;
- Complex(A-B,(r1+i1)*(r2+i2)-A-B);
-];
-*/
-
-
-// Multiplication in combination with complex numbers in the light of infinity
-250 # Complex(r_IsZero,_i) * x_IsInfinity <-- Complex(0,i*x);
-250 # Complex(_r,i_IsZero) * x_IsInfinity <-- Complex(r*x,0);
-251 # Complex(_r,_i) * x_IsInfinity <-- Complex(r*x,i*x);
-
-250 # x_IsInfinity * Complex(r_IsZero,_i) <-- Complex(0,i*x);
-250 # x_IsInfinity * Complex(_r,i_IsZero) <-- Complex(r*x,0);
-251 # x_IsInfinity * Complex(_r,_i) <-- Complex(r*x,i*x);
-
-
-300 # Complex(_r,_i) * y_IsConstant <-- Complex(r*y,i*y);
-300 # y_IsConstant * Complex(_r,_i) <-- Complex(r*y,i*y);
-
-330 # Complex(_r,_i) * (y_IsConstant / _z) <-- (Complex(r*y,i*y))/z;
-330 # (y_IsConstant / _z) * Complex(_r,_i) <-- (Complex(r*y,i*y))/z;
-
-
-110 # x_IsConstant / Complex(_r,_i) <-- (x*Conjugate(Complex(r,i)))/(r^2+i^2);
-
-
-300 # Complex(_r,_i) / y_IsConstant <-- Complex(r/y,i/y);
-
-110 # (_x ^ Complex(_r,_i)) <-- Exp(Complex(r,i)*Ln(x));
-
-110 # Sqrt(Complex(_r,_i)) <-- Exp(Ln(Complex(r,i))/2);
-110 # (Complex(_r,_i) ^ x_IsRationalOrNumber)_(Not(IsInteger(x))) <-- Exp(x*Ln(Complex(r,i)));
-
-// This is commented out because it used PowerN so (2*I)^(-10) became a floating-point number. Now everything is handled by binary algorithm below
-//120 # Complex(r_IsZero,_i) ^ n_IsInteger <-- {1,I,-1,-I}[1+Mod(n,4)] * i^n;
-
-123 # Complex(_r, _i) ^ n_IsNegativeInteger <-- 1/Complex(r, i)^(-n);
-
-124 # Complex(_r, _i) ^ (p_IsZero) <-- 1; // cannot have Complex(0,0) here
-
-125 # Complex(_r, _i) ^ n_IsPositiveInteger <--
-[
- // use binary method
- Local(result, x);
- x:=Complex(r,i);
- result:=1;
- While(n > 0)
- [
- if ((n&1) = 1)
- [
- result := result*x;
- ];
- x := x*x;
- n := n>>1;
- ];
- result;
-];
-
-
-/*[ // this method is disabled b/c it suffers from severe roundoff errors
- Local(rr,ii,count,sign);
- rr:=r^n;
- ii:=0;
- For(count:=1,count<=n,count:=count+2) [
- sign:=If(IsZero(Mod(count-1,4)),1,-1);
- ii:=ii+sign*BinomialCoefficient(n,count)*i^count*r^(n-count);
- If(count I
- Out> Complex(0,1);
- In> 3+4*I
- Out> Complex(3,4);
- In> Complex(-2,0)
- Out> -2;
-
-*SEE Re, Im, I, Abs, Arg
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Conjugate.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Conjugate.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Conjugate.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Conjugate.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="Conjugate"
-
-LocalSymbols(a,x)
-[
-Function("Conjugate",{a})
- Substitute(a,{{x},Type(x)="Complex"},{{x},Complex(x[1],-(x[2]))});
-]; // LocalSymbols(a,x)
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Conjugate",categories="User Functions;Numbers (Complex)"
-*CMD Conjugate --- complex conjugate
-*STD
-*CALL
- Conjugate(x)
-
-*PARMS
-
-{x} -- argument to the function
-
-*DESC
-
-This function returns the complex conjugate of "x". The complex
-conjugate of $a + I*b$ is $a - I*b$. This function assumes that all
-unbound variables are real.
-
-*E.G.
-
- In> Conjugate(2)
- Out> 2;
- In> Conjugate(Complex(a,b))
- Out> Complex(a,-b);
-
-*SEE Complex, Re, Im
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/II.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/II.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/II.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/II.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,12 +0,0 @@
-%mathpiper,def="II",scope="private"
-
-//
-// II is the imaginary number Sqrt(-1), and remains that way.
-// The difference is it isn't converted to the form Complex(x,y).
-//
-
-10 # II^n_IsNegativeInteger <-- (-II)^(-n);
-20 # (II^_n)_(IsEven(n) = True) <-- (-1)^(n>>1);
-20 # (II^_n)_(IsOdd(n) = True) <-- II*(-1)^(n>>1);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/ImII.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/ImII.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/ImII.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/ImII.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="ImII",scope="private"
-
-ImII(_c) <-- NN(c)[2];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Im.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Im.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Im.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Im.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="Im"
-
-/* Imaginary parts */
-110 # Im(Complex(_r,_i)) <-- i;
-120 # Im(Undefined) <-- Undefined;
-300 # Im(_x) <-- 0;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Im",categories="User Functions;Numbers (Complex)"
-*CMD Im --- imaginary part of a complex number
-*STD
-*CALL
- Im(x)
-
-*PARMS
-
-{x} -- argument to the function
-
-*DESC
-
-This function returns the imaginary part of the complex number "x".
-
-*E.G.
-
- In> Im(5)
- Out> 0;
- In> Im(I)
- Out> 1;
- In> Im(Complex(3,4))
- Out> 4;
-
-*SEE Complex, Re
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsComplexII.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsComplexII.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsComplexII.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsComplexII.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsComplexII",scope="private"
-
-IsComplexII(_c) <-- (ImII(c) != 0);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsComplex.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsComplex.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsComplex.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsComplex.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-%mathpiper,def="IsComplex"
-
-/* All things you can request a real and imaginary part for are complex */
-1 # IsComplex(x_IsRationalOrNumber) <-- True;
-2 # IsComplex(Complex(_r,_i)) <-- True;
-3 # IsComplex(_x) <-- False;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsNotComplex.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsNotComplex.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/IsNotComplex.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/IsNotComplex.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsNotComplex",scope="private"
-
-IsNotComplex(x) := Not(IsComplex(x));
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Magnitude.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Magnitude.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Magnitude.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Magnitude.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-%mathpiper,def="Magnitude"
-
-Function("Magnitude",{x}) [
- Sqrt(Re(x)^2 + Im(x)^2);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/NN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/NN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/NN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/NN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-%mathpiper,def="NN",scope="private"
-
-LocalSymbols(complexReduce) [
-
- Set(complexReduce,
- Hold(
- {
- Exp(x_IsComplexII) <- Exp(ReII(x))*(Cos(ImII(x))+II*Sin(ImII(x)))
- }));
-
- NN(_c) <--
- [
- Local(result);
- c := (c /:: complexReduce);
- result := Coef(Expand(c,II),II,{0,1});
- result;
- ];
-
-]; //LocalSymbols(complexReduce)
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef( "Complex" , "complex1","complex_cartesian" );
-OMDef( "Re" , "complex1","real" );
-OMDef( "Im" , "complex1","imaginary" );
-OMDef( "Conjugate", "complex1","conjugate" );
-OMDef( "Arg" , "complex1","argument" );
-OMDef( "IsComplex", mathpiper,"is_complex" );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/ReII.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/ReII.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/ReII.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/ReII.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="ReII",scope="private"
-
-ReII(_c) <-- NN(c)[1];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Re.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Re.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/complex/Re.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/complex/Re.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="Re"
-
-/*Real parts */
-110 # Re(Complex(_r,_i)) <-- r;
-120 # Re(Undefined) <-- Undefined;
-300 # Re(_x) <-- x;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Re",categories="User Functions;Numbers (Complex)"
-*CMD Re --- real part of a complex number
-*STD
-*CALL
- Re(x)
-
-*PARMS
-
-{x} -- argument to the function
-
-*DESC
-
-This function returns the real part of the complex number "x".
-
-*E.G.
-
- In> Re(5)
- Out> 5;
- In> Re(I)
- Out> 0;
- In> Re(Complex(3,4))
- Out> 3;
-
-*SEE Complex, Im
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/constants/constants.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/constants/constants.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/constants/constants.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/constants/constants.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,362 +0,0 @@
-%mathpiper,def="I;CachedConstant;AssignCachedConstants;ClearCachedConstants"
-
-/* def file definitions.
-I
-CachedConstant
-AssignCachedConstants
-ClearCachedConstants
-*/
-
-/* Definition of constants. */
-
-/* TODO:
- * There is a problem with defining I this way: if I is used, but the
- * file "complex" has not been loaded, the interpreter can not deal
- * with "Complex".
- */
-
-SetGlobalLazyVariable(I,Complex(0,1));
-
-//////////////////////////////////////////////////
-/// Cached constants support and definition of Pi
-//////////////////////////////////////////////////
-
-//TODO: here we wrap the entire file in LocalSymbols, this is inefficient in that it slows loading of this file. Needs optimization.
-LocalSymbols(CacheOfConstantsN) [
-
-/// declare a new cached constant C'atom and its associated function C'atom().
-/// C'atom() will call C'func() at current precision to evaluate C'atom if it has not yet been cached at that precision. (note: any arguments to C'func() must be included)
-RuleBase("CachedConstant", {C'cache, C'atom, C'func});
-UnFence("CachedConstant", 3); // not sure if this is useful
-HoldArg("CachedConstant", C'func);
-HoldArg("CachedConstant", C'cache); // name of the cache
-// check syntax: must be called on an atom and a function
-Rule("CachedConstant", 3, 10, And(IsAtom(C'atom), IsFunction(C'func)))
-[
- Local(C'name,C'functionName);
- Set(C'name, String(C'atom)); // this is for later conveniences
- Set(C'functionName,ConcatStrings("Internal'",C'name));
-
- If( // create the cache it if it does not already exist
- IsAtom(Eval(C'cache)),
- MacroSet(Eval(C'cache), {})
- );
-// Write({"debug step 0: ", C'cache, Eval(C'cache), C'atom, C'func, C'name});
- // check that the constant is not already defined
- If(
- Equals(Builtin'Assoc(C'name, Eval(C'cache)), Empty), // the constant is not already defined, so need to define "C'atom" and the corresponding function "C'atom"()
- [ // e.g. C'atom evaluates to Pi, C'cache to a name e.g. CacheOfConstantsN, which is bound to a hash
- MacroClear(C'atom);
-// Write({"debug step 1: ", Cache'name, C'cache, Eval(C'cache)});
- // add the new constant to the cache
-// MacroSet(Cache'name, Insert(Eval(C'cache), 1, {C'name, 0, 0}));
- DestructiveInsert(Eval(C'cache), 1, {C'name, 0, 0});
-// Write({"debug step 2: ", Cache'name, C'cache, Eval(C'cache)});
- // define the new function "C'atom"()
- // note: this should not use N() because it may be called from inside N() itself
-
- MacroRuleBase(C'functionName, {});
- `( Rule(@C'functionName, 0, 1024, True)
- [
- Local(new'prec, new'C, cached'C);
- Set(new'prec, BuiltinPrecisionGet());
- // fetch the cache entry for this constant
- // note that this procedure will store the name of the cache here in this statement as Eval(C'cache)
- Set(cached'C, Builtin'Assoc(@C'name, @C'cache));
- If(
- LessThan(MathNth(cached'C, 2), new'prec),
- [ // need to recalculate at current precision
- If(Equals(InVerboseMode(),True), Echo("CachedConstant: Info: constant ", @C'name, " is being recalculated at precision ", new'prec));
- Set(new'C, Eval(@C'func));
- DestructiveReplace(cached'C, 2, new'prec);
- DestructiveReplace(cached'C, 3, new'C);
- new'C;
- ],
- // return cached value of C'atom
- MathNth(cached'C, 3)
- );
- ]);
-
- // calculate C'atom at current precision for the first time
-// Eval(UnList({C'atom})); // "C'name"();
- // we do not need this until the constant is used; it will just slow us down
- ],
- // the constant is defined
- Echo("CachedConstant: Warning: constant ", C'atom, " already defined")
- );
-];
-
-Rule("CachedConstant", 3, 20, True)
- Echo("CachedConstant: Error: ", C'atom, " must be an atom and ", C'func, " must be a function.");
-
-/// assign numerical values to all cached constants: using fixed cache "CacheOfConstantsN"
-// this is called from N()
-Function("AssignCachedConstantsN", {})
-[
- Local(var,fname);
- ForEach(var, AssocIndices(CacheOfConstantsN))
- [
- MacroClear(Atom(var));
- Set(fname,ConcatStrings("Internal'",var));
- Set(var,Atom(var));
- // this way the routine Internal'Pi() will be actually called only when the variable 'Pi' is used, etcetera.
- `SetGlobalLazyVariable((@var), UnList({Atom(fname)}));
- ];
-];
-UnFence("AssignCachedConstantsN", 0);
-
-/// clear values from all cached constants: using fixed cache "CacheOfConstantsN"
-// this is called from N()
-Function("ClearCachedConstantsN", {})
-[
- Local(c'entry);
- ForEach(c'entry, CacheOfConstantsN)
- MacroClear(Atom(c'entry[1]));
-];
-UnFence("ClearCachedConstantsN", 0);
-
-/// declare some constants now
-CachedConstant(CacheOfConstantsN, Pi,
-[// it seems necessary to precompute Pi to a few more digits
-// so that Cos(0.5*Pi)=0 at precision 10
-// FIXME: find a better solution
- Local(result,old'prec);
- Set(old'prec,BuiltinPrecisionGet());
-If(Equals(InVerboseMode(),True), Echo("Recalculating Pi at precision ",old'prec+5));
- BuiltinPrecisionSet(BuiltinPrecisionGet()+5);
- result := MathPi();
-If(Equals(InVerboseMode(),True),Echo("Switching back to precision ",old'prec));
- BuiltinPrecisionSet(old'prec);
- result;
-]
-);
-CachedConstant(CacheOfConstantsN, gamma, GammaConstNum());
-CachedConstant(CacheOfConstantsN, GoldenRatio, N( (1+Sqrt(5))/2 ) );
-CachedConstant(CacheOfConstantsN, Catalan, CatalanConstNum() );
-
-]; // LocalSymbols(CacheOfConstantsN)
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="I",categories="User Functions;Constants (Mathematical);Numbers (Complex)"
-*CMD I --- imaginary unit
-*STD
-*CALL
- I
-
-*DESC
-
-This symbol represents the imaginary unit, which equals the square
-root of -1. It evaluates to {Complex(0,1)}.
-
-*E.G.
-
- In> I
- Out> Complex(0,1);
- In> I = Sqrt(-1)
- Out> True;
-
-*SEE Complex
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="Pi",categories="User Functions;Constants (Mathematical)"
-*CMD Pi --- mathematical constant $pi$
-
-*STD
-*CALL
- Pi
-
-*DESC
-
-Pi symbolically represents the exact value of $pi$. When the {N()} function is
-used, {Pi} evaluates to a numerical value according to the current precision.
-It is better to use {Pi} than {N(Pi)} except in numerical calculations, because exact
-simplification will be possible.
-
-This is a "cached constant" which is recalculated only when precision is increased.
-
-*E.G.
-
- In> Sin(3*Pi/2)
- Out> -1;
- In> Pi+1
- Out> Pi+1;
- In> N(Pi)
- Out> 3.14159265358979323846;
-
-*SEE Sin, Cos, N, CachedConstant
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="GoldenRatio",categories="User Functions;Constants (Mathematical)"
-*CMD GoldenRatio --- the Golden Ratio
-*STD
-*CALL
- GoldenRatio
-
-*DESC
-
-These functions compute the "golden ratio"
-$$phi <=> 1.6180339887 <=> (1+Sqrt(5))/2 $$.
-
-The ancient Greeks defined the "golden ratio" as follows:
-If one divides a length 1 into two pieces $x$ and $1-x$, such that the ratio of 1 to $x$ is the same as the ratio of $x$ to $1-x$, then $1/x <=> 1.618$... is the "golden ratio".
-
-
-The constant is available symbolically as {GoldenRatio} or numerically through {N(GoldenRatio)}.
-This is a "cached constant" which is recalculated only when precision is increased.
-The numerical value of the constant can also be obtained as {N(GoldenRatio)}.
-
-
-*E.G.
-
- In> x:=GoldenRatio - 1
- Out> GoldenRatio-1;
- In> N(x)
- Out> 0.6180339887;
- In> N(1/GoldenRatio)
- Out> 0.6180339887;
- In> V(N(GoldenRatio,20));
-
- CachedConstant: Info: constant GoldenRatio is
- being recalculated at precision 20
- Out> 1.6180339887498948482;
-
-
-*SEE N, CachedConstant
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="Catalan",categories="User Functions;Constants (Mathematical)"
-*CMD Catalan --- Catalan's Constant
-*STD
-*CALL
- Catalan
-
-*DESC
-
-These functions compute Catalan's Constant $Catalan<=>0.9159655941$.
-
-The constant is available symbolically as {Catalan} or numerically through {N(Catalan)} with {N(...)} the usual operator used to try to coerce an expression in to a numeric approximation of that expression.
-This is a "cached constant" which is recalculated only when precision is increased.
-The numerical value of the constant can also be obtained as {N(Catalan)}.
-The low-level numerical computations are performed by the routine {CatalanConstNum}.
-
-
-*E.G.
-
- In> N(Catalan)
- Out> 0.9159655941;
- In> DirichletBeta(2)
- Out> Catalan;
- In> V(N(Catalan,20))
-
- CachedConstant: Info: constant Catalan is
- being recalculated at precision 20
- Out> 0.91596559417721901505;
-
-
-*SEE N, CachedConstant
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="gamma",categories="User Functions;Constants (Mathematical)"
-*CMD gamma --- Euler's constant $gamma$
-*STD
-*CALL
- gamma
-
-*DESC
-
-These functions compute Euler's constant $gamma<=>0.57722$...
-
-The constant is available symbolically as {gamma} or numerically through using the usual function {N(...)} to get a numeric result, {N(gamma)}.
-This is a "cached constant" which is recalculated only when precision is increased.
-The numerical value of the constant can also be obtained as {N(gamma)}.
-The low-level numerical computations are performed by the routine {GammaConstNum}.
-
-Note that Euler's Gamma function $Gamma(x)$ is the capitalized {Gamma} in MathPiper.
-
-*E.G.
-
- In> gamma+Pi
- Out> gamma+Pi;
- In> N(gamma+Pi)
- Out> 3.7188083184;
- In> V(N(gamma,20))
-
- CachedConstant: Info: constant gamma is being
- recalculated at precision 20
- GammaConstNum: Info: used 56 iterations at
- working precision 24
- Out> 0.57721566490153286061;
-
-*SEE Gamma, N, CachedConstant
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="CachedConstant",categories="User Functions;Constants (Mathematical)"
-*CMD CachedConstant --- precompute multiple-precision constants
-*STD
-*CALL
- CachedConstant(cache, Cname, Cfunc)
-
-*PARMS
-{cache} -- atom, name of the cache
-
-{Cname} -- atom, name of the constant
-
-{Cfunc} -- expression that evaluates the constant
-
-*DESC
-
-This function is used to create precomputed multiple-precision values of
-constants. Caching these values will save time if they are frequently used.
-
-The call to {CachedConstant} defines a new function named {Cname()} that
-returns the value of the constant at given precision. If the precision is
-increased, the value will be recalculated as necessary, otherwise calling {Cname()} will take very little time.
-
-The parameter {Cfunc} must be an expression that can be evaluated and returns
-the value of the desired constant at the current precision. (Most arbitrary-precision mathematical functions do this by default.)
-
-The associative list {cache} contains elements of the form {{Cname, prec, value}}, as illustrated in the example. If this list does not exist, it will be created.
-
-This mechanism is currently used by {N()} to precompute the values of $Pi$ and $gamma$ (and the golden ratio through {GoldenRatio}, and {Catalan}).
-The name of the cache for {N()} is {CacheOfConstantsN}.
-The code in the function {N()} assigns unevaluated calls to {Internal'Pi()} and {Internal'gamma()} to the atoms {Pi} and {gamma} and declares them to be lazy global variables through {SetGlobalLazyVariable} (with equivalent functions assigned to other constants that are added to the list of cached constants).
-
-The result is that the constants will be recalculated only when they are used in the expression under {N()}.
-In other words, the code in {N()} does the equivalent of
-
- SetGlobalLazyVariable(mypi,Hold(Internal'Pi()));
- SetGlobalLazyVariable(mygamma,Hold(Internal'gamma()));
-
-After this, evaluating an expression such as {1/2+gamma} will call the function {Internal'gamma()} but not the function {Internal'Pi()}.
-
-*E.G. notest
-
- In> CachedConstant( my'cache, Ln2, Internal'LnNum(2) )
- Out> True;
- In> Internal'Ln2()
- Out> 0.6931471806;
- In> V(N(Internal'Ln2(),20))
- CachedConstant: Info: constant Ln2 is being
- recalculated at precision 20
- Out> 0.69314718055994530942;
- In> my'cache
- Out> {{"Ln2",20,0.69314718055994530942}};
-
-
-*SEE N, BuiltinPrecisionSet, Pi, GoldenRatio, Catalan, gamma
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/constants/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/constants/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/constants/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/constants/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def=""
-
-//From code.mpi.def:
-OMDef( "I", "nums1", "i" );
-OMDef( "CachedConstant", mathpiper, "CachedConstant" );
-OMDef( "AssignCachedConstants", mathpiper, "AssignCachedConstants" );
-OMDef( "ClearCachedConstants", mathpiper, "ClearCachedConstants" );
-OMDef( "Pi", "nums1", "pi" );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Apply.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Apply.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Apply.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Apply.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,61 +0,0 @@
-%mathpiper,def="Apply"
-
-10 # Apply(_applyoper,_applyargs) _ (Or(IsString(applyoper), IsList(applyoper))) <-- ApplyPure(applyoper,applyargs);
-20 # Apply(applyoper_IsAtom,_applyargs) <-- ApplyPure(String(applyoper),applyargs);
-
-30 # Apply(Lambda(_args,_body),_applyargs) <-- `ApplyPure(Hold({@args,@body}),applyargs);
-UnFence("Apply",2);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Apply",categories="User Functions;Control Flow"
-*CMD Apply --- apply a function to arguments
-*STD
-*CALL
- Apply(fn, arglist)
-
-*PARMS
-
-{fn} -- function to apply
-
-{arglist} -- list of arguments
-
-*DESC
-
-This function applies the function "fn" to the arguments in
-"arglist" and returns the result. The first parameter "fn" can
-either be a string containing the name of a function or a pure
-function. Pure functions, modeled after lambda-expressions, have the
-form "{varlist,body}", where "varlist" is the list of formal
-parameters. Upon application, the formal parameters are assigned the
-values in "arglist" (the second parameter of {Apply}) and the "body" is evaluated.
-
-Another way to define a pure function is with the Lambda construct.
-Here, instead of passing in "{varlist,body}", one can pass in
-"Lambda(varlist,body)". Lambda has the advantage that its arguments
-are not evaluated (using lists can have undesirable effects because
-lists are evaluated). Lambda can be used everywhere a pure function
-is expected, in principle, because the function Apply is the only function
-dealing with pure functions. So all places where a pure function can
-be passed in will also accept Lambda.
-
-An shorthand for {Apply} is provided by the {@} operator.
-
-*E.G.
-
- In> Apply("+", {5,9});
- Out> 14;
-
- In> Apply({{x,y}, x-y^2}, {Cos(a), Sin(a)});
- Out> Cos(a)-Sin(a)^2;
-
- In> Apply(Lambda({x,y}, x-y^2), {Cos(a), Sin(a)});
- Out> Cos(a)-Sin(a)^2
-
- In> Lambda({x,y}, x-y^2) @ {Cos(a), Sin(a)}
- Out> Cos(a)-Sin(a)^2
-
-*SEE Map, MapSingle, @, Lambda
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/else.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/else.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/else.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/else.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="else"
-
-RuleBase("else",{ifthen,otherwise});
-
-0 # (if (_predicate) _body else _otherwise)_(Eval(predicate) = True) <-- Eval(body);
-
-0 # (if (_predicate) _body else _otherwise)_(Eval(predicate) = False) <-- Eval(otherwise);
-
-1 # (if (_predicate) _body else _otherwise) <--
- UnList({Atom("else"),
- UnList({Atom("if"), (Eval(predicate)), body}),
- otherwise});
-
-HoldArg("else",ifthen);
-
-HoldArg("else",otherwise);
-
-UnFence("else",2);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="else",categories="User Functions;Control Flow"
-*CMD else --- branch point
-*STD
-*CALL
- if(predicate) body else otherwise)
-
-*PARMS
-
-{predicate} -- predicate to test
-
-{body} -- expression to evaluate if the predicate is {True}.
-
-{otherwise} -- expression to evaluate if the predicate if {False}.
-
-*DESC
-
-(This description under in development.)
-
-
-*SEE If, if
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEachExperimental.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEachExperimental.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEachExperimental.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEachExperimental.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,66 +0,0 @@
-%mathpiper,def="",public="todo"
-
-/*
- * TODO This was an experiment to try to get to using a new ForEach that works the
- * same on lists and arrays. For some odd reason all sorts of places in the scripts
- * break if we use this version of ForEach. We need to look into this still! I want
- * a ForEach that works on lists as well as arrays.
-
-Macro()(ForEachRest(i,L,B));
-
-LocalSymbols(foreachtail)
-[
- 10 # ForEachRest(_i,L_IsFunction,_B) <--
- [
- Local(foreachtail);
- Local(@i);
- Set(foreachtail,@L);
- While(Not(Equals(foreachtail,{})))
- [
- Set(@i,First(foreachtail));
- @B;
- Set(foreachtail,Rest(foreachtail));
- ];
- ];
-];
-
-LocalSymbols(index,nr)
-[
- 20 # ForEachRest(_i,_A,_B)_( And(
- Equals(IsGeneric(A),True),
- Equals(GenericTypeName(A),"Array")
- )) <--
- [
- Local(index,nr);
- Local(@i);
- Set(index,1);
- Set(nr,Length(@A));
- While(index<=nr)
- [
- Set(@i,(@A)[index]);
- @B;
- Set(index,AddN(index,1));
- ];
- ];
-];
-
-Macro()(ForEach(i,L)(B));
-
-LocalSymbols(itm,lst,bd)
-[
- (ForEach(_i,_L)(_B)) <--
- [
- Local(itm,lst,bd);
-//CurrentFile(),CurrentLine(),,Hold(@B)
-//Echo(CurrentFile(),CurrentLine());
-// Echo("ForEach(",Hold(@i),", ",Hold(@L),", ) ");
- itm:=Hold(@i);
- lst:= (@L);
- bd:=Hold(@B);
-//Echo("1...",itm);
- `ForEachRest(@itm,@lst,@bd);
- ];
-];
-*/
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEachInArray.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEachInArray.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEachInArray.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEachInArray.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,24 +0,0 @@
-%mathpiper,def="ForEachInArray",scope="private"
-
-LocalSymbols(i,nr)
-[
- TemplateFunction("ForEachInArray",{item,list,body})
- [
- Local(i,nr);
- MacroLocal(item);
- Set(i,1);
- Set(nr,Length(list));
- While(i<=nr)
- [
- MacroSet(item,list[i]);
- Eval(body);
- Set(i,AddN(i,1));
- ];
- ];
-];
-
-UnFence("ForEachInArray",3);
-HoldArgNr("ForEachInArray",3,1);
-HoldArgNr("ForEachInArray",3,3);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEach.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEach.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/ForEach.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/ForEach.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,101 +0,0 @@
-%mathpiper,def="ForEach"
-
-Retract("ForEach" , *);
-
-/*TODO remove? Not yet. If the code above (ForEachExperimental) can be made to work we can do away with this version. */
-TemplateFunction("ForEach",{item,listOrString,body})
-[
- If(And(Equals(IsGeneric(listOrString),True),
- Equals(GenericTypeName(listOrString),"Array")
- ),
- `ForEachInArray(@item,listOrString,@body),
- [
-
- MacroLocal(item);
-
- If(IsString(listOrString),
- [
-
- Local(index, stringLength);
-
- stringLength := Length(listOrString);
-
- index := 1;
- While(index <= stringLength )
- [
- MacroSet(item,listOrString[index] );
-
- Eval(body);
-
- index++;
- ];
-
- ],
- [
- Local(foreachtail);
- Set(foreachtail,listOrString);
- While(Not(Equals(foreachtail,{})))
- [
- MacroSet(item,First(foreachtail));
- Eval(body);
- Set(foreachtail,Rest(foreachtail));
- ];
- ]);
- ]);
-];
-UnFence("ForEach",3);
-HoldArgNr("ForEach",3,1);
-HoldArgNr("ForEach",3,3);
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-%mathpiper_docs,name="ForEach",categories="User Functions;Control Flow"
-*CMD ForEach --- loop over all entries in a list or a string
-*STD
-*CALL
- ForEach(var, list_or_string) body
-
-*PARMS
-
-{var} -- looping variable
-
-{list} -- list of values or string of characters to assign to "var"
-
-{body} -- expression to evaluate with different values of "var"
-
-*DESC
-
-The expression "body" is evaluated multiple times. The first time,
-"var" has the value of the first element of "list" or the first
-character in "string", then it gets
-the value of the second element and so on. {ForEach}
-returns {True}.
-
-*E.G. notest
-
- In> ForEach(i,{2,3,5,7,11}) Echo({i, i!});
- 2 2
- 3 6
- 5 120
- 7 5040
- 11 39916800
- Out> True;
-
-
- In> ForEach(i,"Hello") Echo(i)
- Result: True
- Side Effects:
- H
- e
- l
- l
- o
-
-*SEE For, While, Until, Break, Continue
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/For.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/For.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/For.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/For.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-%mathpiper,def="For"
-
-/* Defining a For function */
-TemplateFunction("For",{start,predicate,increment,body})
-[
- Eval(start);
- While (Equals(Eval(predicate),True))
- [
- Eval(body);
- Eval(increment);
- ];
-];
-UnFence("For",4);
-HoldArgNr("For",4,1);
-HoldArgNr("For",4,2);
-HoldArgNr("For",4,3);
-HoldArgNr("For",4,4);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="For",categories="User Functions;Control Flow"
-*CMD For --- C-style {for} loop
-*STD
-*CALL
- For(init, pred, incr) body
-
-*PARMS
-
-{init} -- expression for performing the initialization
-
-{pred} -- predicate deciding whether to continue the loop
-
-{incr} -- expression to increment the counter
-
-{body} -- expression to loop over
-
-*DESC
-
-This commands implements a C style {for} loop. First
-of all, the expression "init" is evaluated. Then the predicate
-"pred" is evaluated, which should return {True} or
-{False}. Next the loop is executed as long as the
-predicate yields {True}. One traversal of the loop
-consists of the subsequent evaluations of "body", "incr", and
-"pred". Finally, the value {True} is returned.
-
-This command is most often used in a form such as {For(i=1, i<=10, i++) body}, which evaluates {body} with
-{i} subsequently set to 1, 2, 3, 4, 5, 6, 7, 8, 9,
-and 10.
-
-The expression {For(init, pred, incr) body} is
-equivalent to {init; While(pred) [body; incr;]}.
-
-*E.G. notest
-
- In> For (i:=1, i<=10, i++) Echo({i, i!});
- 1 1
- 2 2
- 3 6
- 4 24
- 5 120
- 6 720
- 7 5040
- 8 40320
- 9 362880
- 10 3628800
- Out> True;
-
-*SEE While, Until, ForEach, Break, Continue
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/if.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/if.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/if.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/if.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="if"
-
-RuleBase("if",{predicate,body});
-
-(if(True) _body) <-- Eval(body);
-
-HoldArg("if",body);
-
-UnFence("if",2);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="if",categories="User Functions;Control Flow"
-*CMD if --- branch point
-*STD
-*CALL
- if(predicate)body
-
-*PARMS
-
-{predicate} -- predicate to test
-
-{body} -- expression to evaluate if the predicate is true
-
-*DESC
-
-(This description is in development.)
-
-
-*SEE If, else
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Lambda.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Lambda.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Lambda.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Lambda.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="Lambda"
-
-/* Lambda was introduced as a form of pure function that can be passed on to the function Apply as a first argument.
- * The original method, passing it in as a list, had the disadvantage that the list was evaluated, which caused the
- * arguments to be evaluated too. This resulted in unwanted behaviour sometimes (expressions being prematurely evaluated
- * in the body of the pure function). The arguments to Lambda are not evaluated.
- */
-DefMacroRuleBase("Lambda",{args,body});
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="Lambda",categories="User Functions;Control Flow"
-*CMD Lambda --- a form of pure function that can be passed to functions like Apply and Select
-*STD
-*CALL
- Lambda(arglist, function body)
-
-*PARMS
-
-{arglist} -- list of arguments
-
-*DESC
-
-Lambda functions are unnamed pure functions which can be used in places where a small function
-is needed and creating a normal function is either inconvenient or impossible.
-
-*E.G.
-In> Apply(Lambda({x,y}, x-y^2), {Cos(a), Sin(a)});
-Out> Cos(a)-Sin(a)^2
-
-In> Lambda({x,y}, x-y^2) @ {Cos(a), Sin(a)}
-Out> Cos(a)-Sin(a)^2
-
-
-\%mathpiper
-
-list := {1,-3,2,-6,-4,3};
-
-Select(Lambda({i}, i > 0 ),list);
-
-\%/mathpiper
-
- \%output,preserve="false"
- Result: {1,2,3}
-. \%/output
-
-*SEE Apply, @, Select
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Until.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Until.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/contolflow/Until.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/contolflow/Until.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,69 +0,0 @@
-%mathpiper,def="Until"
-
-TemplateFunction("Until",{predicate,body})
-[
- Eval(body);
- While (Equals(Eval(predicate),False))
- [
- Eval(body);
- ];
- True;
-];
-UnFence("Until",2);
-HoldArgNr("Until",2,1);
-HoldArgNr("Until",2,2);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Until",categories="User Functions;Control Flow"
-*CMD Until --- loop until a condition is met
-*STD
-*CALL
- Until(pred) body
-
-*PARMS
-
-{pred} -- predicate deciding whether to stop
-
-{body} -- expression to loop over
-
-*DESC
-
-Keep on evaluating "body" until "pred" becomes {True}. More precisely, {Until} first
-evaluates the expression "body". Then the predicate "pred" is
-evaluated, which should yield either {True} or {False}. In the latter case, the expressions "body"
-and "pred" are again evaluated and this continues as long as
-"pred" is {False}. As soon as "pred" yields {True}, the loop terminates and {Until} returns {True}.
-
-The main difference with {While} is that {Until} always evaluates the body at least once, but {While} may not evaluate the body at all. Besides, the
-meaning of the predicate is reversed: {While} stops
-if "pred" is {False} while {Until} stops if "pred" is {True}.
-The command
-{Until(pred) body;} is equivalent to {pred; While(Not pred) body;}. In fact, the
-implementation of {Until} is based on the internal
-command {While}. The {Until}
-command can be compared to the {do ... while}
-construct in the programming language C.
-
-*E.G. notest
-
- In> x := 0;
- Out> 0;
- In> Until (x! > 10^6) \
- [ Echo({x, x!}); x++; ];
- 0 1
- 1 1
- 2 2
- 3 6
- 4 24
- 5 120
- 6 720
- 7 5040
- 8 40320
- 9 362880
- Out> True;
-
-*SEE While, For, ForEach, Break, Continue
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/debug/debug.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/debug/debug.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/debug/debug.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/debug/debug.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,346 +0,0 @@
-%mathpiper,def="TraceExp;Debug;Profile;DebugRun;DebugStep;DebugStepOver;DebugBreakAt;DebugRemoveBreakAt;DebugStop;DebugVerbose;DebugAddBreakpoint;BreakpointsClear;DebugCallstack;DebugBreakIf;DebugLocals;EchoTime;DebugShowCode"
-
-/* def file definitions
-TraceExp
-Debug
-Profile
-DebugRun
-DebugStep
-DebugStepOver
-DebugBreakAt
-DebugRemoveBreakAt
-DebugStop
-DebugVerbose
-DebugAddBreakpoint
-BreakpointsClear
-DebugCallstack
-DebugBreakIf
-DebugLocals
-EchoTime
-DebugShowCode
-*/
-
-LocalSymbols(TraceStart,TraceEnter,TraceLeave,DebugStart,DebugEnter,
- DebugLeave,ProfileStart,ProfileEnter,result,
- WriteLines,ClearScreenString,Debug'FileLoaded, Debug'FileLines, Debug'NrLines,
- debugstepoverfile, debugstepoverline) [
-
-TraceStart() := [indent := 0;];
-TraceEnter() :=
-[
- indent++;
- Space(2*indent);
- Echo("Enter ",CustomEval'Expression());
-];
-TraceLeave() :=
-[
- Space(2*indent);
- Echo("Leave ",CustomEval'Result());
- indent--;
-];
-Macro(TraceExp,{expression})
-[
- TraceStart();
- CustomEval(TraceEnter(),TraceLeave(),CustomEval'Stop(),@expression);
-];
-
-
-
-DebugStart():=
-[
- debugging:=True;
- debugstopdepth := -1;
- breakpoints:={};
- filebreakpoints := {};
- debugstopped:=False;
- debugverbose:=False;
- debugcallstack:={};
- breakpredicate:=False;
-];
-DebugRun():= [debugging:=False;True;];
-DebugStep():=[debugging:=False;nextdebugging:=True;];
-
-DebugStepOver():=
-[
- debugging:=False;
- debugstepoverfile := DebugFile(CustomEval'Expression());
- debugstepoverline := DebugLine(CustomEval'Expression());
- debugstopdepth := Length(debugcallstack);
-];
-DebugBreakAt(file,line):=
-[
- Check(InDebugMode(),"DebugBreakAt only supported in the debug build of MathPiper");
- If(filebreakpoints[file] = Empty,filebreakpoints[file]:={});
- DestructiveAppend(filebreakpoints[file],line);
-];
-DebugRemoveBreakAt(file,line):=
-[
- Check(InDebugMode(),"DebugRemoveBreakAt only supported in the debug build of MathPiper");
- If(filebreakpoints[file] = Empty,filebreakpoints[file]:={});
- filebreakpoints[file] := Difference(filebreakpoints[file],{line});
-];
-
-
-DebugStop():=[debugging:=False;debugstopped:=True;CustomEval'Stop();];
-DebugVerbose(verbose):=[debugverbose:=verbose;];
-DebugAddBreakpoint(fname_IsString) <-- [ breakpoints := fname:breakpoints;];
-Macro(DebugBreakIf,{predicate})
-[
- breakpredicate:= Hold(@predicate);
-];
-
-BreakpointsClear() <--
-[
- breakpredicate:=False;
- breakpoints := {};
-];
-Macro(DebugLocals,{})
-[
- Echo("");
- Echo("*************** Current locals on the stack ****************");
- ForEach(item,CustomEval'Locals())
- [
- Echo(" ",item," : ",Eval(item));
- ];
- Echo("");
-];
-DebugCallstack() <--
-[
- Echo("");
- Echo("*************** Function call stack ****************");
- ForEach(item,debugcallstack)
- [
- if(IsFunction(item))
- Echo(" Function ",Type(item)," : ",item)
- else
- Echo(" Variable ",item);
- ];
- Echo("");
-];
-
-Macro(DebugEnter,{})
-[
- debugcallstack := CustomEval'Expression():debugcallstack;
- // custom breakpoint (custom predicate thought up by the programmer)
- If(debugging = False And
- Eval(breakpredicate) = True,
- [
- breakpredicate:=False;
- debugging:=True;
- ]);
-
- If(debugging = False And InDebugMode(),
- [
- Local(file,line);
- file := DebugFile(CustomEval'Expression());
- If(filebreakpoints[file] != Empty,
- [
- line := DebugLine(CustomEval'Expression());
- If(Not(file = debugstepoverfile And line = debugstepoverline) And
- Contains(filebreakpoints[file],line),
- [
- debugging:=True;
- ]
- );
- ]);
- ]);
-
-
- // the standard breakpoint
- If(debugging = False And
- IsFunction(CustomEval'Expression()) And
- Contains(breakpoints,Type(CustomEval'Expression())), debugging:=True);
- nextdebugging:=False;
- If (debugging,
- [
- If(InDebugMode(),DebugShowCode());
- Echo(">>> ",CustomEval'Expression());
- While(debugging)
- [
- Echo("DebugOut> ",Eval(FromString(ReadCmdLineString("Debug> "):";")Read()));
- // If(debugging,Echo("DebugOut> ",debugRes));
- If(IsExitRequested(),debugging:=False);
- ];
- ]);
- debugging:=nextdebugging;
-
- If(IsExitRequested(),debugstopped:=True);
-
-];
-Macro(DebugLeave,{})
-[
- If(debugging = False And debugstopdepth >= 0 And Length(debugcallstack) = debugstopdepth,
- [
- debugstepoverline := -1;
- debugging := True;
- debugstopdepth := -1;
- ]);
-
- debugcallstack := Rest(debugcallstack);
- If(debugverbose,Echo(CustomEval'Result()," <-- ",CustomEval'Expression()));
-];
-Macro(Debug,{expression})
-ToStdout()
-[
- DebugStart();
- CustomEval(DebugEnter(),DebugLeave(),If(debugstopped,Check(False,""),[debugging:=True;debugcallstack := Rest(debugcallstack);]),@expression);
-];
-
-
-ProfileStart():=
-[
- profilefn:={};
-];
-10 # ProfileEnter()_(IsFunction(CustomEval'Expression())) <--
-[
- Local(fname);
- fname:=Type(CustomEval'Expression());
- If(profilefn[fname]=Empty,profilefn[fname]:=0);
- profilefn[fname] := profilefn[fname]+1;
-];
-Macro(Profile,{expression})
-[
- ProfileStart();
- CustomEval(ProfileEnter(),True,CustomEval'Stop(),@expression);
- ForEach(item,profilefn)
- Echo("Function ",item[1]," called ",item[2]," times");
-];
-
-/// Measure the time taken by evaluation and print results.
-Macro(EchoTime,{expression})
-[
- Local(result);
- Echo(Time()Set(result, @expression), "seconds taken.");
- result;
-];
-
-
-
-// ClearScreenString : the ascii escape codes to clear the screen
-ClearScreenString := CharString(27):"[2J":CharString(27):"[1;1H";
-
-// WriteLines: do the actual outputting of lines of a file to screen
-WriteLines(filename,lines,from,nrlines,breakpoints,current):=
-[
- Local(i,nr);
- nr:=Length(lines);
- WriteString(ClearScreenString);
- Echo("File ",filename," at line ",current);
- For(i:=from,i")
- else
- WriteString(" ");
- if (Contains(breakpoints,i))
- WriteString("*")
- else
- WriteString(" ");
- WriteString("| ");
- Echo(lines[i][1]);
- ];
-];
-Debug'FileLoaded := "";
-Debug'FileLines := {};
-Debug'NrLines:=20;
-
-//
-// DebugShowCode: show the part of the file we are currently executing (based on the
-// value returned by CustomEval'Expression() ).
-//
-// Currently unimplemented, should we remove?
-//
-DebugShowCode():=
-[
- False;
-];
-
-]; //LocalSymbols
-
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="TraceExp",categories="User Functions;Control Flow"
-*CMD TraceExp --- evaluate with tracing enabled
-*CORE
-*CALL
- TraceExp(expr)
-
-*PARMS
-
-{expr} -- expression to trace
-
-*DESC
-
-The expression "expr" is evaluated with the tracing facility turned
-on. This means that every subexpression, which is evaluated, is shown
-before and after evaluation. Before evaluation, it is shown in the
-form {TrEnter(x)}, where {x}
-denotes the subexpression being evaluated. After the evaluation the
-line {TrLeave(x,y)} is printed, where {y} is the result of the evaluation. The indentation
-shows the nesting level.
-
-Note that this command usually generates huge amounts of output. A
-more specific form of tracing (eg. {TraceRule}) is
-probably more useful for all but very simple expressions.
-
-*E.G. notest
-
- In> TraceExp(2+3);
- TrEnter(2+3);
- TrEnter(2);
- TrLeave(2, 2);
- TrEnter(3);
- TrLeave(3, 3);
- TrEnter(IsNumber(x));
- TrEnter(x);
- TrLeave(x, 2);
- TrLeave(IsNumber(x),True);
- TrEnter(IsNumber(y));
- TrEnter(y);
- TrLeave(y, 3);
- TrLeave(IsNumber(y),True);
- TrEnter(True);
- TrLeave(True, True);
- TrEnter(MathAdd(x,y));
- TrEnter(x);
- TrLeave(x, 2);
- TrEnter(y);
- TrLeave(y, 3);
- TrLeave(MathAdd(x,y),5);
- TrLeave(2+3, 5);
- Out> 5;
-
-*SEE TraceStack, TraceRule
-%/mathpiper_docs
-
-
-
-
-%mathpiper_docs,name="EchoTime",categories="User Functions;Input/Output"
-*CMD EchoTime --- measure the time taken by a function and echos it
-*STD
-*CALL
- EchoTime()expr
-*PARMS
-{expr} -- any expression
-*DESC
-
-The function {EchoTime()expr} evaluates the expression {expr} and prints the time in seconds needed for the evaluation.
-The time is printed to the current output stream.
-The built-in function {Time} is used for timing.
-
-The result is the "user time" as reported by the OS, not the real ("wall clock") time.
-Therefore, any CPU-intensive processes running alongside MathPiper will not significantly affect the result of {EchoTime}.
-
-*E.G. notest
- In> EchoTime() N(MathLog(1000),40)
- 0.34 seconds taken
- Out> 6.9077552789821370520539743640530926228033;
-
-*SEE Time, SystemTimer
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/debug/verbose_mode.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/debug/verbose_mode.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/debug/verbose_mode.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/debug/verbose_mode.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,68 +0,0 @@
-%mathpiper,def="V;InVerboseMode"
-
-LocalSymbols(Verbose) [
-
- Set(Verbose,False);
-
-
- Function("V",{aNumberBody})
- [
- Local(prevVerbose,result);
- Set(prevVerbose,Verbose);
- Set(Verbose,True);
- Set(result,Eval(aNumberBody));
- Set(Verbose,prevVerbose);
- result;
- ];
-
-
- Function("InVerboseMode",{}) Verbose;
-
-]; // LocalSymbols(Verbose)
-
-HoldArg("V",aNumberBody);
-UnFence("V",1);
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="V;InVerboseMode",categories="User Functions;Input/Output"
-*CMD V, InVerboseMode --- set verbose output mode
-*STD
-*CALL
- V(expression)
- InVerboseMode()
-
-*PARMS
-
-{expression} -- expression to be evaluated in verbose mode
-
-*DESC
-
-The function {V(expression)} will evaluate the expression in
-verbose mode. Various parts of MathPiper can show extra information
-about the work done while doing a calculation when using {V}.
-
-In verbose mode, {InVerboseMode()} will return {True}, otherwise
-it will return {False}.
-
-*E.G. notest
-
- In> OldSolve({x+2==0},{x})
- Out> {{-2}};
- In> V(OldSolve({x+2==0},{x}))
- Entering OldSolve
- From x+2==0 it follows that x = -2
- x+2==0 simplifies to True
- Leaving OldSolve
- Out> {{-2}};
- In> InVerboseMode()
- Out> False
- In> V(InVerboseMode())
- Out> True
-
-*SEE Echo, N, OldSolve
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/colon_equals_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/colon_equals_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/colon_equals_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/colon_equals_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,278 +0,0 @@
-%mathpiper,def=":="
-
-/* := assignment. */
-RuleBase(":=",{aLeftAssign,aRightAssign});
-UnFence(":=",2);
-HoldArg(":=",aLeftAssign);
-HoldArg(":=",aRightAssign);
-
-/* := assignment. */
-// assign a variable
-Rule(":=",2,0,IsAtom(aLeftAssign))
-[
- Check( Not IsNumber(aLeftAssign), "Only a variable can be placed on the left side of an := operator." );
-
- MacroSet(aLeftAssign,Eval(aRightAssign));
-
- Eval(aLeftAssign);
-];
-
-
-
-// assign lists
-Rule(":=",2,0,IsList(aLeftAssign))
-[
- Map(":=",{aLeftAssign,Eval(aRightAssign)});
-];
-
-// auxiliary function to help assign arrays using :=
-RuleBase("AssignArray",{setlistterm,setlistindex,setlistresult});
-UnFence("AssignArray",3);
-Rule("AssignArray",3,1,IsString(setlistindex))
-[
- Local(item);
- item:=Assoc(setlistindex,setlistterm);
- If(item = Empty,
- DestructiveInsert(setlistterm,1,{setlistindex,setlistresult}),
- DestructiveReplace(item,2,setlistresult)
- );
- True;
-];
-// assign generic arrays
-Rule("AssignArray",3,1,
- And(
- Equals(IsGeneric(setlistterm),True),
- Equals(GenericTypeName(setlistterm),"Array")
- )
- )
-[
- ArraySet(setlistterm,setlistindex,setlistresult);
-];
-
-
-Rule("AssignArray",3,2,True)
-[
- DestructiveReplace(setlistterm ,setlistindex, setlistresult);
- True;
-];
-
-// a[x] := ... assigns to an array element
-Rule(":=",2,10,IsFunction(aLeftAssign) And (First(Listify(aLeftAssign)) = Nth))
-[
- Local(frst,scnd);
-
- Local(lst);
- Set(lst,(Listify(aLeftAssign)));
- Set(lst,Rest(lst));
- Set(frst, Eval(First(lst)));
- Set(lst,Rest(lst));
- Set(scnd, Eval(First(lst)));
-
- AssignArray(frst,scnd,Eval(aRightAssign));
-];
-
-// f(x):=... defines a new function
-Rule(":=",2,30,IsFunction(aLeftAssign) And Not(Equals(aLeftAssign[0], Atom(":="))) )
-[
- Check( Not Equals(aLeftAssign[0], Atom("/")), "Only a variable can be placed on the left side of an := operator." );
-
- Local(oper,args,arity);
- Set(oper,String(aLeftAssign[0]));
- Set(args,Rest(Listify(aLeftAssign)));
- If(
- And(GreaterThan(Length(args), 1), Equals( MathNth(args, Length(args)), Atom("...") )),
- // function with variable number of arguments
- [
- DestructiveDelete(args,Length(args)); // remove trailing "..."
- Set(arity,Length(args));
- Retract(oper,arity);
- MacroRuleBaseListed(oper, args);
- ],
- // function with a fixed number of arguments
- [
- Set(arity,Length(args));
- Retract(oper,arity);
- MacroRuleBase(oper, args);
- ]
- );
- UnHoldable(aRightAssign);
- MacroRule(oper,arity,1025,True) aRightAssign;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name=":=",categories="Operators"
-*CMD := --- assign a variable or a list; define a function
-*STD
-*CALL
- var := expr
- {var1, var2, ...} := {expr1, expr2, ...}
- var[i] := expr
- fn(arg1, arg2, ...) := expr
-Precedence:
-*EVAL OpPrecedence(":=")
-
-*PARMS
-
-{var} -- atom, variable which should be assigned
-
-{expr} -- expression to assign to the variable or body of function
-
-{i} -- index (can be integer or string)
-
-{fn} -- atom, name of a new function to define
-
-{arg1}, {arg2} -- atoms, names of arguments of the new function {fn}
-
-*DESC
-
-The {:=} operator can be used
-in a number of ways. In all cases, some sort of assignment or definition takes
-place.
-
-The first form is the most basic one. It evaluates the expression on
-the right-hand side and assigns it to the variable named on the
-left-hand side. The left-hand side is not evaluated. The evaluated
-expression is also returned.
-
-The second form is a small extension, which allows one to do multiple
-assignments. The first entry in the list on the right-hand side is
-assigned to the first variable mentioned in the left-hand side, the
-second entry on the right-hand side to the second variable on the
-left-hand side, etc. The list on the right-hand side must have at
-least as many entries as the list on the left-hand side. Any excess
-entries are silently ignored. The result of the expression is the list
-of values that have been assigned.
-
-The third form allows one to change an entry in the list. If the index
-"i" is an integer, the "i"-th entry in the list is changed to the
-expression on the right-hand side. It is assumed that the length of
-the list is at least "i". If the index "i" is a string, then
-"var" is considered to be an associative list (sometimes called hash
-table), and the key "i" is paired with the value "exp". In both
-cases, the right-hand side is evaluated before the assignment and the
-result of the assignment is {True}.
-
-The last form defines a function. For example, the assignment {fn(x) := x^2} removes any rules previously associated with {fn(x)} and defines the rule {fn(_x) <-- x^2}. Note that the left-hand side may take a different form if
-{fn} is defined to be a prefix, infix or bodied function. This case
-is special since the right-hand side is not evaluated
-immediately, but only when the function {fn} is used. If this takes
-time, it may be better to force an immediate evaluation with {Eval} (see the last example). If the expression on the right hand side begins with {Eval()}, then it will be evaluated before defining the new function.
-
-A variant of the function definition can be used to make a function accepting a variable number of arguments. The last argument
-
-*E.G.
-
-A simple assignment:
-
- In> a := Sin(x) + 3;
- Out> Sin(x)+3;
- In> a;
- Out> Sin(x)+3;
-
-Multiple assignments:
-
- In> {a,b,c} := {1,2,3};
- Out> {1,2,3};
- In> a;
- Out> 1;
- In> b+c;
- Out> 5;
-
-Assignment to a list:
-
- In> xs := { 1,2,3,4,5 };
- Out> {1,2,3,4,5};
- In> xs[3] := 15;
- Out> True;
- In> xs;
- Out> {1,2,15,4,5};
-
-Building an associative list:
-
- In> alist := {};
- Out> {};
- In> alist["cherry"] := "red";
- Out> True;
- In> alist["banana"] := "yellow";
- Out> True;
- In> alist["cherry"];
- Out> "red";
- In> alist;
- Out> {{"banana","yellow"},{"cherry","red"}};
-
-Defining a function:
-
- In> f(x) := x^2;
- Out> True;
- In> f(3);
- Out> 9;
- In> f(Sin(a));
- Out> Sin(a)^2;
-
-Defining a function with variable number of arguments:
-
- In> f(x, ...) := If(IsList(x),Sum(x),x);
- Out> True;
- In> f(2);
- Out> 2;
- In> f(1,2,3);
- Out> 6;
-
-Defining a new infix operator:
-
- In> Infix("*&*",10);
- Out> True;
- In> x1 *&* x2 := x1/x2 + x2/x1;
- Out> True;
- In> Sin(a) *&* Cos(a);
- Out> Tan(1)+Cos(1)/Sin(1);
- In> Clear(a);
- Out> True;
- In> Sin(a) *&* Exp(a);
- Out> Sin(a)/Exp(a)+Exp(a)/Sin(a);
-
-In the following example, it may take some time to compute the Taylor
-expansion. This has to be done every time the function {f} is called.
-
- In> f(a) := Taylor(x,0,25) Sin(x);
- Out> True;
- In> f(1);
- Out> x-x^3/6+x^5/120-x^7/5040+x^9/362880-
- x^11/39916800+x^13/6227020800-x^15/
- 1307674368000+x^17/355687428096000-x^19/
- 121645100408832000+x^21/51090942171709440000
- -x^23/25852016738884976640000+x^25
- /15511210043330985984000000;
- In> f(2);
- Out> x-x^3/6+x^5/120-x^7/5040+x^9/362880-
- x^11/39916800+x^13/6227020800-x^15
- /1307674368000+x^17/355687428096000-x^19/
- 121645100408832000+x^21/51090942171709440000
- -x^23/25852016738884976640000+x^25/
- 15511210043330985984000000;
-
-The remedy is to evaluate the Taylor expansion immediately. Now the
-expansion is computed only once.
-
- In> f(a) := Eval(Taylor(x,0,25) Sin(x));
- Out> True;
- In> f(1);
- Out> x-x^3/6+x^5/120-x^7/5040+x^9/362880-
- x^11/39916800+x^13/6227020800-x^15/
- 1307674368000+x^17/355687428096000-x^19/
- 121645100408832000+x^21/51090942171709440000
- -x^23/25852016738884976640000+x^25
- /15511210043330985984000000;
- In> f(2);
- Out> x-x^3/6+x^5/120-x^7/5040+x^9/362880-
- x^11/39916800+x^13/6227020800-x^15
- /1307674368000+x^17/355687428096000-x^19/
- 121645100408832000+x^21/51090942171709440000
- -x^23/25852016738884976640000+x^25/
- 15511210043330985984000000;
-
-*SEE Set, Clear, [], Rule, Infix, Eval, Function
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Function.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Function.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Function.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Function.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,133 +0,0 @@
-%mathpiper,def="Function"
-
-/* Defining a macro-like function that declares a function
- * with only one rule.
- */
-RuleBase("Function",{oper,args,body});
-
-
-
-// function with variable number of arguments: Function("func",{x,y, ...})body;
-Rule("Function",3,2047,
- And(GreaterThan(Length(args), 1), Equals( MathNth(args, Length(args)), Atom("...") ))
-)
-[
- DestructiveDelete(args,Length(args)); // remove trailing "..."
- Retract(oper,Length(args));
- MacroRuleBaseListed(oper,args);
- MacroRule(oper,Length(args),1025,True) body; // at precedence 1025, for flexibility
-];
-
-// function with a fixed number of arguments
-Rule("Function",3,2048,True)
-[
- Retract(oper,Length(args));
- MacroRuleBase(oper,args);
- MacroRule(oper,Length(args),1025,True) body;
-];
-
-
-/// shorthand function declarations
-RuleBase("Function",{oper});
-// function with variable number of arguments: Function() f(x,y, ...)
-Rule("Function",1,2047,
- And(IsFunction(oper), GreaterThan(Length(oper), 1), Equals( MathNth(oper, Length(oper)), Atom("...") ))
-)
-[
- Local(args);
- Set(args,Rest(Listify(oper)));
- DestructiveDelete(args,Length(args)); // remove trailing "..."
- If(RuleBaseDefined(Type(oper),Length(args)),
- False, // do nothing
- MacroRuleBaseListed(Type(oper),args)
- );
-];
-
-
-// function with a fixed number of arguments
-Rule("Function",1,2048,
- And(IsFunction(oper))
-)
-[
- Local(args);
- Set(args,Rest(Listify(oper)));
- If(RuleBaseDefined(Type(oper),Length(args)),
- False, // do nothing
- MacroRuleBase(Type(oper),args)
- );
-];
-
-
-HoldArg("Function",oper);
-HoldArg("Function",args);
-HoldArg("Function",body);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Function",categories="User Functions;Control Flow"
-*CMD Function --- declare or define a function
-*STD
-*CALL
- Function() func(arglist)
- Function() func(arglist, ...)
- Function("op", {arglist}) body
- Function("op", {arglist, ...}) body
-
-*PARMS
-
-{func(args)} -- function declaration, e.g. {f(x,y)}
-
-{"op"} -- string, name of the function
-
-{{arglist}} -- list of atoms, formal arguments to the function
-
-{...} -- literal ellipsis symbol "{...}" used to denote a variable number of arguments
-
-{body} -- expression comprising the body of the function
-
-*DESC
-
-This command can be used to define a new function with named arguments.
-
-
-The number of arguments of the new function and their names are determined by the list {arglist}. If the ellipsis "{...}" follows the last atom in {arglist}, a function with a variable number of arguments is declared (using {RuleBaseListed}). Note that the ellipsis cannot be the only element of {arglist} and must be preceded by an atom.
-
-A function with variable number of arguments can take more arguments than elements in {arglist}; in this case, it obtains its last argument as a list containing all extra arguments.
-
-The short form of the {Function} call merely declares a {RuleBase} for the new function but does not define any function body. This is a convenient shorthand for {RuleBase} and {RuleBaseListed}, when definitions of the function are to be supplied by rules. If the new function has been already declared with the same number of arguments (with or without variable arguments), {Function} returns false and does nothing.
-
-The second, longer form of the {Function} call declares a function and also defines a function body. It is equivalent to a
-single rule such as {op(_arg1, _arg2) <-- body}. The rule will be declared at
-precedence 1025. Any previous rules associated with {"op"} (with the same
-arity) will be discarded. More complicated functions (with more than one body)
-can be defined by adding more rules.
-
-*E.G. notest
-
-This will declare a new function with two or more arguments, but define no rules for it. This is equivalent to {RuleBase ("f1", {x, y, ...})}.
- In> Function() f1(x,y,...);
- Out> True;
- In> Function() f1(x,y);
- Out> False;
-
-This defines a function {FirstOf} which returns the
-first element of a list. Equivalent definitions would be
-{FirstOf(_list) <-- list[1]} or {FirstOf(list) := list[1]}.
- In> Function("FirstOf", {list}) list[1];
- Out> True;
- In> FirstOf({a,b,c});
- Out> a;
-
-The following function will print all arguments to a string:
- In> Function("PrintAll",{x, ...}) If(IsList(x),
- PrintList(x), ToString()Write(x));
- Out> True;
- In> PrintAll(1):
- Out> " 1";
- In> PrintAll(1,2,3);
- Out> " 1 2 3";
-
-*SEE TemplateFunction, Rule, RuleBase, RuleBaseListed, :=, Retract
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/HoldArgNr.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/HoldArgNr.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/HoldArgNr.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/HoldArgNr.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="HoldArgNr"
-
-Function("HoldArgNr",{function,arity,index})
-[
- Local(args);
- args:=RuleBaseArgList(function,arity);
-/* Echo({"holdnr ",args}); */
- ApplyPure("HoldArg",{function,args[index]});
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HoldArgNr"
-*CMD HoldArgNr --- specify argument as not evaluated
-*STD
-*CALL
- HoldArgNr("function", arity, argNum)
-
-*PARMS
-{"function"} -- string, function name
-
-{arity}, {argNum} -- positive integers
-
-*DESC
-
-Declares the argument numbered {argNum} of the function named {"function"} with
-specified {arity} to be unevaluated ("held"). Useful if you don't know symbolic
-names of parameters, for instance, when the function was not declared using an
-explicit {RuleBase} call. Otherwise you could use {HoldArg}.
-
-*SEE HoldArg, RuleBase
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Macro.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Macro.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Macro.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Macro.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,118 +0,0 @@
-%mathpiper,def="Macro"
-
-RuleBase("Macro",{oper,args,body});
-HoldArg("Macro",oper);
-HoldArg("Macro",args);
-HoldArg("Macro",body);
-
-// macro with variable number of arguments: Macro("func",{x,y, ...})body;
-Rule("Macro",3,2047,
- And(GreaterThan(Length(args), 1), Equals( MathNth(args, Length(args)), Atom("...") ))
-)
-[
- DestructiveDelete(args,Length(args)); // remove trailing "..."
- Retract(oper,Length(args));
- `DefMacroRuleBaseListed(@oper,@args);
- MacroRule(oper,Length(args),1025,True) body; // at precedence 1025, for flexibility
-];
-
-// macro with a fixed number of arguments
-Rule("Macro",3,2048,True)
-[
- Retract(oper,Length(args));
- `DefMacroRuleBase(@oper,@args);
- MacroRule(oper,Length(args),1025,True) body;
-];
-
-RuleBase("Macro",{oper});
-// macro with variable number of arguments: Macro() f(x,y, ...)
-Rule("Macro",1,2047,
- And(IsFunction(oper), GreaterThan(Length(oper), 1), Equals( MathNth(oper, Length(oper)), Atom("...") ))
-)
-[
- Local(args,name);
- Set(args,Rest(Listify(oper)));
- DestructiveDelete(args,Length(args)); // remove trailing "..."
- Set(name,Type(oper));
- If(RuleBaseDefined(Type(oper),Length(args)),
- False, // do nothing
- `DefMacroRuleBaseListed(@name,@args)
- );
-];
-// macro with a fixed number of arguments
-Rule("Macro",1,2048,
- And(IsFunction(oper))
-)
-[
- Local(args,name);
- Set(args,Rest(Listify(oper)));
- Set(name,Type(oper));
- If(RuleBaseDefined(Type(oper),Length(args)),
- False, // do nothing
- [
- `DefMacroRuleBase(@name,@args);
- ]
- );
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Macro",categories="User Functions;Control Flow"
-*CMD Macro --- declare or define a macro
-*STD
-*CALL
- Macro() func(arglist)
- Macro() func(arglist, ...)
- Macro("op", {arglist}) body
- Macro("op", {arglist, ...}) body
-
-*PARMS
-
-{func(args)} -- function declaration, e.g. {f(x,y)}
-
-{"op"} -- string, name of the function
-
-{{arglist}} -- list of atoms, formal arguments to the function
-
-{...} -- literal ellipsis symbol "{...}" used to denote a variable number of arguments
-
-{body} -- expression comprising the body of the function
-
-*DESC
-
-This does the same as {Function}, but for macros. One can define a macro
-easily with this function, in stead of having to use {DefMacroRuleBase}.
-
-*E.G. notest
-
-the following example defines a looping function.
-
- In> Macro("myfor",{init,pred,inc,body}) [@init;While(@pred)[@body;@inc;];True;];
- Out> True;
- In> a:=10
- Out> 10;
-
-Here this new macro {myfor} is used to loop, using a variable {a} from the
-calling environment.
-
- In> myfor(i:=1,i<10,i++,Echo(a*i))
- 10
- 20
- 30
- 40
- 50
- 60
- 70
- 80
- 90
- Out> True;
- In> i
- Out> 10;
-
-*SEE Function, DefMacroRuleBase
-%/mathpiper_docs
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/TemplateFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/TemplateFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/TemplateFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/TemplateFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,22 +0,0 @@
-%mathpiper,def="TemplateFunction"
-
-RuleBase("TemplateFunction",{oper,args,body});
-Bodied("TemplateFunction",60000);
-HoldArg("TemplateFunction",oper);
-HoldArg("TemplateFunction",args);
-HoldArg("TemplateFunction",body);
-Rule("TemplateFunction",3,2047,True)
-[
- Retract(oper,Length(args));
- Local(arglist);
- arglist:=FlatCopy(args);
-
- DestructiveAppend(arglist,{args,UnList({Hold,body})});
- arglist:=ApplyPure("LocalSymbols",arglist);
-
- MacroRuleBase(oper,arglist[1]);
- MacroRule(oper,Length(args),1025,True) arglist[2];
-
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Unholdable.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Unholdable.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deffunc/Unholdable.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deffunc/Unholdable.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="UnHoldable",scope="private"
-
-// this will "unhold" a variable - used to make sure that := with Eval()
-// immediately on the right hand side evaluates its argument
-RuleBase("UnHoldable",{var});
-HoldArg("UnHoldable",var);
-UnFence("UnHoldable",1);
-Rule("UnHoldable",1,10,Equals(Type(Eval(var)),"Eval"))
-[
- MacroSet(var,Eval(Eval(var)));
-/* Echo({"unheld",var,Eval(var)}); */
-];
-Rule("UnHoldable",1,20,True)
-[
-/* Echo({"held"}); */
- True;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Curl.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Curl.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Curl.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Curl.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="Curl"
-
-RuleBase("Curl", {aFunc, aBasis});
-
-Rule("Curl", 2, 1, Length(aBasis)=Length(aFunc))
- {
- Apply("D",{aBasis[2],aFunc[3]})-Apply("D",{aBasis[3],aFunc[2]}),
- Apply("D",{aBasis[3],aFunc[1]})-Apply("D",{aBasis[1],aFunc[3]}),
- Apply("D",{aBasis[1],aFunc[2]})-Apply("D",{aBasis[2],aFunc[1]})
- };
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Curl",categories="User Functions;Calculus Related (Symbolic)"
-*CMD Curl --- curl of a vector field
-*STD
-*CALL
- Curl(vector, basis)
-
-*PARMS
-
-{vector} -- vector field to take the curl of
-
-{basis} -- list of variables forming the basis
-
-*DESC
-
-This function takes the curl of the vector field "vector" with
-respect to the variables "basis". The curl is defined in the usual way,
-
- Curl(f,x) = {
- D(x[2]) f[3] - D(x[3]) f[2],
- D(x[3]) f[1] - D(x[1]) f[3],
- D(x[1]) f[2] - D(x[2]) f[1]
- }
-Both "vector" and "basis" should be lists of length 3.
-
-*E.G.
-
- In> Curl({x*y,x*y,x*y},{x,y,z})
- Out> {x,-y,y-x};
-
-*SEE D, Diverge
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Deriv.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Deriv.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Deriv.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Deriv.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,87 +0,0 @@
-%mathpiper,def="Deriv",scope="private"
-
-
-5 # (Deriv(_var,1)_func) <-- Deriv(var)func;
-5 # (Deriv(_var,0)_func) <-- func;
-10 # (Deriv(_var,n_IsPositiveInteger)_func) <-- Deriv(var)Deriv(var,n-1)func;
-10 # (Deriv(_var,n_IsNegativeInteger)_func) <-- Check(0,"Negative derivative");
-
-
-// Need to clean out Sec(x) and friends
-0 # (Deriv(_var) (_var)) <-- 1;
-1 # (Deriv(_var)func_IsAtom) <-- 0;
-2 # (Deriv(_var)_x + _y) <-- (Deriv(var)x) + (Deriv(var)y);
-2 # (Deriv(_var)- (_x) ) <-- -Deriv(var)x;
-2 # (Deriv(_var)_x - _y) <-- (Deriv(var)x) - (Deriv(var)y);
-2 # (Deriv(_var)_x * _y) <-- (x*Deriv(var)y) + (Deriv(var)x)*y;
-2 # (Deriv(_var)Sin(_x)) <-- (Deriv(var)x)*Cos(x);
-2 # (Deriv(_var)Sinh(_x))<-- (Deriv(var)x)*Cosh(x);
-2 # (Deriv(_var)Cosh(_x))<-- (Deriv(var)x)*Sinh(x);
-2 # (Deriv(_var)Cos(_x)) <-- -(Deriv(var)x)*Sin(x);
-2 # (Deriv(_var)Csc(_x)) <-- -(Deriv(var)x)*Csc(x)*Cot(x);
-2 # (Deriv(_var)Csch(_x)) <-- -(Deriv(var)x)*Csch(x)*Coth(x);
-2 # (Deriv(_var)Sec(_x)) <-- (Deriv(var)x)*Sec(x)*Tan(x);
-2 # (Deriv(_var)Sech(_x)) <-- -(Deriv(var)x)*Sech(x)*Tanh(x);
-2 # (Deriv(_var)Cot(_x)) <-- -(Deriv(var)x)*Csc(x)^2;
-2 # (Deriv(_var)Coth(_x)) <-- (Deriv(var)x)*Csch(x)^2;
-
-2 # (Deriv(_var)Tan(_x)) <-- ((Deriv(var) x) / (Cos(x)^2));
-2 # (Deriv(_var)Tanh(_x)) <-- (Deriv(var)x)*Sech(x)^2;
-
-2 # (Deriv(_var)Exp(_x)) <-- (Deriv(var)x)*Exp(x);
-
-// When dividing by a constant, this is faster
-2 # (Deriv(_var)(_x / _y))_(IsFreeOf(var,y)) <-- (Deriv(var) x) / y;
-3 # (Deriv(_var)(_x / _y)) <--
- (y* (Deriv(var) x) - x* (Deriv(var) y))/ (y^2);
-
-2 # (Deriv(_var)Ln(_x)) <-- ((Deriv(var) x) / x);
-2 # (Deriv(_var)(_x ^ _n))_(IsRationalOrNumber(n) Or IsFreeOf(var, n)) <--
- n * (Deriv(var) x) * (x ^ (n - 1));
-
-2 # (Deriv(_var)(Abs(_x))) <-- Sign(x)*(Deriv(var)x);
-2 # (Deriv(_var)(Sign(_x))) <-- 0;
-
-2 # (Deriv(_var)(if(_cond)(_body))) <--
- UnList({Atom("if"),cond,Deriv(var)body});
-2 # (Deriv(_var)((_left) else (_right))) <--
- UnList({Atom("else"), (Deriv(var)left), (Deriv(var)right) } );
-
-3 # (Deriv(_var)(_x ^ _n)) <-- (x^n)*Deriv(var)(n*Ln(x));
-
-2 # (Deriv(_var)ArcSin(_x)) <-- (Deriv(var) x )/Sqrt(1 -(x ^ 2));
-2 # (Deriv(_var)ArcCos(_x)) <-- -(Deriv(var)x)/Sqrt(1 -(x^2));
-2 # (Deriv(_var)ArcTan(_x)) <-- (Deriv(var) x)/(1 + x^2);
-2 # (Deriv(_var)Sqrt(_x)) <-- ((Deriv(var)x)/(2*Sqrt(x)));
-2 # (Deriv(_var)Complex(_r,_i)) <-- Complex(Deriv(var)r,Deriv(var)i);
-
-LocalSymbols(var,var2,a,b,y)[
- 2 # (Deriv(_var)Integrate(_var)(_y)) <-- y;
- 2 # (Deriv(_var)Integrate(_var2,_a,_b)(y_IsFreeOf(var))) <--
- (Deriv(var)b)*(y Where var2 == b) -
- (Deriv(var)a)*(y Where var2 == a);
- 3 # (Deriv(_var)Integrate(_var2,_a,_b)(_y)) <--
- (Deriv(var)b)*(y Where var2 == b) -
- (Deriv(var)a)*(y Where var2 == a) +
- Integrate(var2,a,b) Deriv(var) y;
- ];
-
-
-
-2 # (Deriv(_var)func_IsList)_(Not(IsList(var))) <--
- Map("Deriv",{FillList(var,Length(func)),func});
-
-
-2 # (Deriv(_var)UniVariate(_var,_first,_coefs)) <--
-[
- Local(result,m,i);
- result:=FlatCopy(coefs);
- m:=Length(result);
- For(i:=1,i<=m,i++)
- [
- result[i] := result[i] * (first+i-1);
- ];
- UniVariate(var,first-1,result);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Diverge.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Diverge.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/Diverge.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/Diverge.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="Diverge"
-
-RuleBase("Diverge", {aFunc, aBasis});
-Rule("Diverge", 2, 1, IsList(aBasis) And IsList(aFunc) And Length(aBasis) = Length(aFunc))
- Add(Map("D", {aBasis,aFunc}));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Diverge",categories="User Functions;Calculus Related (Symbolic)"
-*CMD Diverge --- divergence of a vector field
-*STD
-*CALL
- Diverge(vector, basis)
-
-*PARMS
-
-{vector} -- vector field to calculate the divergence of
-
-{basis} -- list of variables forming the basis
-
-*DESC
-
-This function calculates the divergence of the vector field "vector"
-with respect to the variables "basis". The divergence is defined as
-
- Diverge(f,x) = D(x[1]) f[1] + ...
- + D(x[n]) f[n],
-where {n} is the length of the lists "vector" and
-"basis". These lists should have equal length.
-
-*E.G.
-
- In> Diverge({x*y,x*y,x*y},{x,y,z})
- Out> y+x;
-
-*SEE D, Curl
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/D.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/D.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/deriv/D.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/deriv/D.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,94 +0,0 @@
-%mathpiper,def="D"
-
-RuleBase("D",{aVar,aFunc});
-RuleBase("D",{aVar,aCount,aFunc});
-
-Rule("D",2,1,IsList(aVar) And Not(IsList(aFunc)))
- Map("D",{aVar,FillList(aFunc, Length(aVar))});
-Rule("D",2,1,IsList(aVar) And IsList(aFunc))
- Map("D",{aVar,aFunc});
-
-Rule("D",2,3,True)
-[
- MacroLocal(aVar);
- Apply("Deriv",{aVar,1,aFunc});
-];
-
-Rule("D",3,1,IsList(aVar) And Not(IsList(aFunc)))
- Map("D",{aVar,
- FillList(aCount, Length(aVar)),
- FillList(aFunc, Length(aVar))});
-Rule("D",3,1,IsList(aVar) And IsList(aFunc))
- Map("D",{aVar,
- FillList(aCount, Length(aVar)),
- aFunc});
-Rule("D",3,3,True)
-[
- MacroLocal(aVar);
- Apply("Deriv",{aVar,aCount,aFunc});
-];
-
-
-HoldArg("D",aVar);
-HoldArg("D",aFunc);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="D",categories="User Functions;Calculus Related (Symbolic)"
-*CMD D --- take derivative of expression with respect to variable
-*STD
-*CALL
- D(variable) expression
- D(list) expression
- D(variable,n) expression
-
-*PARMS
-
-{variable} -- variable
-
-{list} -- a list of variables
-
-{expression} -- expression to take derivatives of
-
-{n} -- order of derivative
-
-*DESC
-
-This function calculates the derivative of the expression {expr} with
-respect to the variable {var} and returns it. If the third calling
-format is used, the {n}-th derivative is determined. MathPiper knows
-how to differentiate standard functions such as {Ln}
-and {Sin}.
-
-The {D} operator is threaded in both {var} and
-{expr}. This means that if either of them is a list, the function is
-applied to each entry in the list. The results are collected in
-another list which is returned. If both {var} and {expr} are a
-list, their lengths should be equal. In this case, the first entry in
-the list {expr} is differentiated with respect to the first entry in
-the list {var}, the second entry in {expr} is differentiated with
-respect to the second entry in {var}, and so on.
-
-The {D} operator returns the original function if $n=0$, a common
-mathematical idiom that simplifies many formulae.
-
-*E.G.
-
- In> D(x)Sin(x*y)
- Out> y*Cos(x*y);
- In> D({x,y,z})Sin(x*y)
- Out> {y*Cos(x*y),x*Cos(x*y),0};
- In> D(x,2)Sin(x*y)
- Out> -Sin(x*y)*y^2;
- In> D(x){Sin(x),Cos(x)}
- Out> {Cos(x),-Sin(x)};
-
-*SEE Integrate, Taylor, Diverge, Curl
-%/mathpiper_docs
-
- %output,preserve="false"
-
-. %/output
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/equations/EquationLeft.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/equations/EquationLeft.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/equations/EquationLeft.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/equations/EquationLeft.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="EquationLeft"
-
-EquationLeft(_symbolicEquation)_(Type(symbolicEquation) = "==") <--
-[
- Local(listForm);
-
- listForm := Listify(symbolicEquation);
-
- listForm[2];
-];
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="EquationLeft",categories="User Functions;Expression Manipulation"
-*CMD EquationLeft --- return the left side of a symbolic equation
-*STD
-*CALL
- EquationLeft(equation)
-
-*PARMS
-
-{equation} -- symbolic equation.
-
-
-*DESC
-
-A symbolic equation is an equation which is defined using the == operator. This
-function returns the left side of a symbolic equation.
-
-*E.G.
-
- In> e := y^2 == 4*p*x
- Result> y^2==4*p*x
-
- In> EquLeft(e)
- Result> y^2
-
-*SEE ==, EquationRight
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/equations/EquationRight.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/equations/EquationRight.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/equations/EquationRight.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/equations/EquationRight.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="EquationRight"
-
-EquationRight(_symbolicEquation)_(Type(symbolicEquation) = "==") <--
-[
- Local(listForm);
-
- listForm := Listify(symbolicEquation);
-
- listForm[3];
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="EquationRight",categories="User Functions;Expression Manipulation"
-*CMD EquationRight --- return the right side of a symbolic equation
-*STD
-*CALL
- EquationRight(equation)
-
-*PARMS
-
-{equation} -- symbolic equation.
-
-
-*DESC
-
-A symbolic equation is an equation which is defined using the == operator. This
-function returns the right side of a symbolic equation.
-
-*E.G.
-
- In> e := y^2 == 4*p*x
- Result> y^2==4*p*x
-
- In> EquationRight(e)
- Result> 4*p*x
-
-*SEE ==, EquationLeft
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/example/Example.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/example/Example.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/example/Example.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/example/Example.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,101 +0,0 @@
-%mathpiper,def="Example"
-
-
-
-examplelist:=
-Hold(
-{
- {40!,
-"Simple factorial of a number.
-"
- },
- {D(x)Sin(x),
-"Taking the derivative of a function (the derivative of Sin(x) with
-respect to x in this case).
-"
- },
- {Taylor(x,0,5)Sin(x),
-"Expanding a function into a taylor series.
-"
- },
- {Integrate(x,a,b)Sin(x),
-"Integrate a function.
-"
- },
- {Solve(a+x*y==z,x),
-"Solve a function for a variable.
-"
- },
- {Limit(x,0) Sin(x)/x,
-"Take a limit.
-"
- },
- {Subst(x,Cos(a)) x+x,
-"Substitute an expression with another in the main expression.
-"
- },
- {Expand((1+x)^3),
-"Expand into a polynomial.
-"
- },
- {2^40,
-"Big numbers.
-"
- },
- {1<<40,
-"Bitwise operations
-"
- },
- {1 .. 4,
-"Generating a list of numbers.
-"
- },
- {a:b:c:{},
-"Generating a list of items.
-"
- },
- {[Local(x);x:={a,b,c};Sin(x)^2;],
-"Threading: Sin(..)^2 will be performed on all elements of the list
-passed in.
-"
- },
- {[Local(list);list:={a,b,c,d,e,f}; list[2 .. 4];],
-"Selecting a sublist from a list.
-"
- },
- {PermutationsList({a,b,c}),
-"Generate all permutations of a list.
-"
- },
- {VarList(a+b*x),
-"Show all variables that occur in an expression.
-"
- },
- {TrigSimpCombine(Cos(a)*Cos(a)+Sin(a)*Sin(a)),
-"Convert factors between trigonometric functions to addition of
-trigonometric functions.
-"
- }
-}
-);
-exampleindex:=0;
-
-Example():=
-[
- exampleindex++;
- If (exampleindex>Length(examplelist),exampleindex:=1);
-
- Local(example);
- example:=examplelist[exampleindex];
- WriteString("Current example : ");
- Write(example[1]);WriteString(";");NewLine();
- NewLine();
- WriteString(example[2]);
- NewLine();
- Eval(example[1]);
-];
-
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/BinaryFactors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/BinaryFactors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/BinaryFactors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/BinaryFactors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,298 +0,0 @@
-%mathpiper,def="BinaryFactors",public="todo"
-
-LocalSymbols(lastcoef,OrdBuild, AddFoundSolutionSingle , AddFoundSolution, Fct, MkfactD)
-[
-
-LastCoef(_vector,_p) <--
-[
- Local(n);
- n:=Length(vector);
- Add(vector*p^(0 .. (n-1)));
-];
-
-/*
-Ord(vector,q):=
-[
- Local(n);
- n:=Length(vector);
- q*Coef(Simplify(LastCoef(vector,p+q)-LastCoef(vector,p)),q,1);
-];
-*/
-
-OrdBuild(vector,q):=
-[
- Local(i,result,n);
- Set(i,2);
- Set(result, 0);
- Set(n, Length(vector));
- While (i<=n)
- [
- Set(result,result+(i-1)*vector[i]*p^(i-2));
- Set(i, i+2);
- ];
- q*result;
-];
-
-
-Function(AddFoundSolutionSingle,{p})
-[
- Local(calc);
-// If ( Not Contains(result,p),
-// [
- Set(calc, Eval(lastcoef));
- If (Equals(calc, 0),
- [
- Local(newlist,count,root);
- count:=0;
- root := p;
- Local(rem);
-
- rem:={-root,1};
- {testpoly,rem}:=MkfactD(testpoly,rem);
-
- rem:={-root,1};
- {newlist,rem}:=MkfactD(poly,rem);
- While (rem = {})
- [
- count++;
- Set(poly,newlist);
- rem:={-root,1};
- {newlist,rem}:=MkfactD(poly,rem);
- ];
-
- Local(lgcd,lc);
- Set(lgcd,Gcd({andiv,an,root}));
- Set(lc,Div(an,lgcd));
- Set(result,{var+ (-(Div(root,lgcd)/lc)),count}:result);
- Set(andiv,Div(andiv,lgcd^count));
- Set(anmul,anmul*lc^count);
-
-// factor:=(x-root);
-// Set(result,{factor,count}:result);
-
- Local(p,q);
- Set(lastcoef, LastCoef(testpoly,p));
- Set(ord, OrdBuild(testpoly,q));
- ]);
-// ]);
-];
-UnFence(AddFoundSolutionSingle,1);
-
-Function(AddFoundSolution,{p})
-[
- AddFoundSolutionSingle(p);
- AddFoundSolutionSingle(-2*q+p);
-];
-UnFence(AddFoundSolution,1);
-
-Function(Fct,{poly,var})
-[
- Local(maxNrRoots,result,ord,p,q,accu,calc,twoq,mask);
-
- Local(gcd);
- [
- Set(gcd,Gcd(poly));
- If(poly[Length(poly)] < 0,Set(gcd, gcd * -1));
- Set(poly,poly/gcd);
- ];
-
- Local(unrat);
- Set(unrat,Lcm(MapSingle("Denominator",poly)));
- Set(poly,unrat*poly);
-
- Local(origdegree);
- Set(origdegree,Length(poly)-1);
-
- Local(an,andiv,anmul);
- Set(an,poly[Length(poly)]);
- Set(poly,poly* (an^((origdegree-1) .. -1)));
- Set(andiv,an^(origdegree-1));
- Set(anmul,1);
-
- Local(leadingcoef,lowestcoef);
- Set(leadingcoef,poly[Length(poly)]);
- [
- Local(i);
- Set(i,1);
- Set(lowestcoef,Abs(poly[i]));
- While (lowestcoef = 0 And i<=Length(poly))
- [
- Set(i,i+1);
- Set(lowestcoef,Abs(poly[i]));
- ];
- ];
- // testpoly is the square-free version of the polynomial, used for finding
- // the factors. the original polynomials is kept around to find the
- // multiplicity of the factor.
- Local(testpoly);
-// Set(testpoly,Mkc(Div(polynom,Monic(Gcd(polynom,Deriv(var)polynom))),var));
- Local(deriv);
- // First determine a derivative of the original polynomial
- deriv:=Rest(poly);
- [
- Local(i);
- For (i:=1,i<=Length(deriv),i++)
- [
- deriv[i] := deriv[i]*i;
- ];
-// Echo("POLY = ",poly);
-// Echo("DERIV = ",deriv);
- ];
- [
- Local(q,r,next);
- q:=poly;
- r:=deriv;
- While(r != {})
- [
-//Echo(q,r);
- next := MkfactD(q,r)[2];
- q:=r;
- r:=next;
- ];
- // now q is the gcd of the polynomial and its first derivative.
-
- // Make it monic
- q:=q/q[Length(q)];
- testpoly:=MkfactD(poly,q)[1];
-//Echo("TESTPOLY = ",testpoly);
- ];
-
-// Set(testpoly,poly); //@@@
-
- Set(maxNrRoots,Length(testpoly)-1);
- Set(result, {});
-
- Set(lastcoef, LastCoef(testpoly,p));
- Set(ord, OrdBuild(testpoly,q));
-
- Set(accu,{});
- Set(q,1);
- Set(twoq,MultiplyN(q,2));
- Set(mask,AddN(twoq,MathNegate(1)));
- if (IsEven(testpoly[1]))
- [
- Set(accu,0:accu);
- AddFoundSolutionSingle(0);
- ];
- Set(p,1);
- Set(calc, Eval(lastcoef));
- If (IsEven(calc),
- [
- Set(accu,1:accu);
- AddFoundSolution(1);
- ]);
- Set(q,twoq);
- Set(twoq,MultiplyN(q,2));
- Set(mask,AddN(twoq,MathNegate(1)));
- While(Length(result)0 And q<=Abs(testpoly[1]))
- [
- Local(newaccu);
- Set(newaccu,{});
- ForEach(p,accu)
- [
- Set(calc,Eval(lastcoef));
- If (LessThan(calc,0),
- Set(calc, AddN(calc,MultiplyN(twoq,DivN(AddN(MathNegate(calc),twoq),twoq))))
- );
- Set(calc, BitAnd(calc, mask));
- If ( Equals(calc, 0),
- [
- Set(newaccu, p:newaccu);
- AddFoundSolutionSingle(-2*q+p);
- ]);
- Set(calc, AddN(calc, Eval(ord)));
- If (LessThan(calc,0),
- Set(calc, AddN(calc,MultiplyN(twoq,DivN(AddN(MathNegate(calc),twoq),twoq))))
- );
- Set(calc, BitAnd(calc, mask));
- If ( Equals(calc, 0),
- [
- Set(newaccu, AddN(p,q):newaccu);
- AddFoundSolution(AddN(p,q));
- ]);
- ];
- Set(accu, newaccu);
- Set(q,twoq);
- Set(twoq,MultiplyN(q,2));
- Set(mask,AddN(twoq,MathNegate(1)));
-
-//Echo("q = ",q);
-//Echo("Length is",Length(accu),"accu = ",accu);
-//Echo("result = ",result);
- ];
-
- // If the polynom is not one, it is a polynomial which is not reducible any further
- // with this algorithm, return as is.
- Set(poly,poly*an^(0 .. (Length(poly)-1)));
- Set(poly,gcd*anmul*poly);
- //TODO had to add this if statement, what was andiv again, and why would it become zero? This happens with for example Factor(2*x^2)
- If(Not IsZero(unrat * andiv ),Set(poly,poly/(unrat * andiv )));
- If(poly != {1},
- [
- result:={(Add(poly*var^(0 .. (Length(poly)-1)))),1}:result;
- ]);
- result;
-];
-
-
-
-BinaryFactors(expr):=
-[
- Local(result,uni,coefs);
- uni:=MakeUni(expr,VarList(expr)[1]);
- uni:=Listify(uni);
- coefs:=uni[4];
- coefs:=Concat(ZeroVector(uni[3]),coefs);
- result:=Fct(coefs,uni[2]);
-// Echo(result,list);
-// Echo((Add(list*x^(0 .. (Length(list)-1)))));
-// Product(x-result)*(Add(list*x^(0 .. (Length(list)-1))));
- result;
-];
-
-
-
-MkfactD(numer,denom):=
-[
- Local(q,r,i,j,ln,ld,nq);
- DropEndZeroes(numer);
- DropEndZeroes(denom);
- Set(numer,Reverse(numer));
- Set(denom,Reverse(denom));
- Set(ln,Length(numer));
- Set(ld,Length(denom));
- Set(q,FillList(0,ln));
- Set(r,FillList(0,ln));
-
- Set(i,1);
- If(ld>0,
- [
- While(Length(numer)>=Length(denom))
- [
- Set(nq,numer[1]/denom[1]);
- q[ln-(Length(numer)-ld)] := nq;
- For(j:=1,j<=Length(denom),j++)
- [
- numer[j] := (numer[j] - nq*denom[j]);
- ];
- r[i] := r[1] + numer[1];
-
- Set(numer, Rest(numer));
- i++;
- ];
- ]);
- For(j:=0,j 1, // if this is > 1, we need to separate some factors. Gcd() is very fast
- small'powers := TrialFactorize(n, 257), // value is {n1, {p1,q1}, {p2,q2}, ...} and n1=1 if completely factorized into these factors, and the remainder otherwise
- small'powers := {n} // pretend we had run TrialFactorize without success
- );
- n := small'powers[1]; // remainder
- If(n=1, Rest(small'powers),
- // if n!=1, need to factorize the remainder with Pollard Rho algorithm
- [
- If(InVerboseMode(), Echo({"FactorizeInt: Info: remaining number ", n}));
- SortFactorList(
- PollardCombineLists(Rest(small'powers), PollardRhoFactorize(n))
- );
- ]
- );
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Factor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Factor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Factor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Factor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="Factor"
-
-// This is so Factor(Sin(x)) doesn't return FWatom(Sin(x))
-//Factor(_p) <-- FW(Factors(p));
-10 # Factor(p_CanBeUni) <-- FW(Factors(p));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Factor",categories="User Functions;Number Theory"
-*CMD Factor --- factorization (in pretty form)
-*STD
-*CALL
- Factor(x)
-
-*PARMS
-
-{x} -- integer or univariate polynomial
-
-*DESC
-
-This function factorizes "x", similarly to {Factors}, but
-it shows the result in a nicer human readable format.
-
-*E.G.
-
- In> PrettyForm(Factor(24));
-
- 3
- 2 * 3
-
- Out> True;
- In> PrettyForm(Factor(2*x^3 + 3*x^2 - 1));
-
- 2 / 1 \
- 2 * ( x + 1 ) * | x - - |
- \ 2 /
-
- Out> True;
-
-*SEE Factors, IsPrime, PrettyForm
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FactorQS.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FactorQS.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FactorQS.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FactorQS.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,18 +0,0 @@
-%mathpiper,def="FactorQS"
-
-// numbers
-
-// The bud of an Quadratic Seive algorithm
-// congruence solving code must be written first
-Function("FactorQS",{n})[
- Local(x,k,fb,j);
- // optimal number of primes in factor base
- // according to Fundamental Number Theory with Applications - Mollin, p130
- k:=Round(N(Sqrt(Exp(Sqrt(Ln(n)*Ln(Ln(n)))))));
- fb:=ZeroVector(k);
- For(j:=1,j<=k,j++)[
- fb[j]:=NextPrime(j);
- ];
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Factors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Factors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Factors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Factors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,237 +0,0 @@
-%mathpiper,def="Factors"
-
-Retract("Factors",*);
-Retract("FactorsMultivariateSpecialCases",*);
-Retract("FactorsSomethingElse",*);
-Retract("CombineNumericalFactors",*);
-
-/*
- * Factors() is the fundamental factorization algorithm.
- * It works for integers, rational numbers, Gaussian integers, and polynomials
- * When the argument is an integer, FactorizeInt() does the heavy lifting.
- * When the argument is a polynomial, BinaryFactors() is the workhorse.
- */
-
-10 # Factors(p_IsPositiveInteger) <-- FactorizeInt(p);
-
-11 # Factors(p_IsInteger) <-- FactorizeInt(p);
- // Added because otherwise negative integers (and 0) get processed as Gaussian Integers
-
-12 # Factors(p_IsRational)_(Denominator(p) != 1) <-- {{Factor(Numerator(p)) /Factor(Denominator(p)) , 1}};
- // Added to handle rational numbers with denominators that are not 1
-
-14 # Factors(p_IsGaussianInteger) <-- GaussianFactors(p);
-
-20 # Factors(p_CanBeUni)_(Length(VarList(p)) = 1) <--
-[
- Local(x,coeffs,factorsList,result);
- x := VarList(p)[1];
- /* p is the polynomial, x is its (only) variable */
-
- factorsList := BinaryFactors(p);
- // BinaryFactors is the internal MathPiper function that
- // creates a double list of factors and their multiplicities
- /*
- * Now we check whether the input polynomial is "over the
- * integers", by examining all its coefficients
- */
- coeffs := Coef(p,x,0 .. Degree(p,x));
- If( AllSatisfy("IsInteger",coeffs),
- [
- // Yes -- all integer coefficients
- result := FactorsPolynomialOverIntegers(p,x);
- ],
- [
- // No -- at least one non-integer coefficient
- // Check for FLOAT or RATIONAL coefficients
- Local(notInt,rat,dd,lcm,newCoeffs,NewPoly,facs);
- notInt := Select(Lambda({i},Not IsInteger(i)),coeffs);
- rat := Rationalize(coeffs);
- dd := MapSingle("Denominator",rat);
- lcm := Lcm(dd);
- newCoeffs := lcm * rat;
- newPoly := NormalForm(UniVariate(x,0,newCoeffs));
- facs := FactorsPolynomialOverIntegers(newPoly);
- If( InVerboseMode(), [
- Echo("coeffs ",coeffs);
- Echo("notInt ",notInt);
- Echo("rat ",rat);
- Echo("dd ",dd);
- Echo("lcm ",lcm);
- Echo("newCoeffs ",newCoeffs);
- Echo("newPoly ",newPoly);
- Echo("facs ",facs);
- ]
- );
- result := {(1/lcm),1}:facs;
- //NOT FINISHED YET
- ]
- );
- CombineNumericalFactors( result );
-];
-
-
-30 # Factors(p_CanBeUni) <--
-[
- /*
- * This may be a multi-variate polynomial, or it may be something else.
- * Original YY function Factors() did not attempt to factor such.
- * If it is a multivariate polynomial, we will try certain
- * Special cases which we can relatively easily factor.
- * If it is "something else", we will have to check, on a
- * case-by-case basis.
- */
- Local(nvars,result);
- nvars := Length(VarList(p));
- If (nvars > 1,
- [
- If( InVerboseMode(),
- [
- Echo("special ",p);
- Echo(Coef(p,x,0 .. 8));
- ]
- );
- result := FactorsMultivariateSpecialCases(p);
- ],
- result := FactorsSomethingElse(p)
- );
- CombineNumericalFactors( result );
-];
-
-
-40 # Factors(_p) <--
-[
- /*
- * This may may be a polynomial with non-integer exponents. Let's check.
- */
- If( InVerboseMode(), Echo("Possibly trying to factor polynomial with non-integral exponents") );
- Local( result);
- //Echo(40,p);
- // NOT IMPLEMENTED YET
- result := {{p,1}};
- CombineNumericalFactors( result );
-
-];
-
-//------------------------------------------------------------------------
-// S P E C I A L C A S E S
-//------------------------------------------------------------------------
-
-10 # FactorsMultivariateSpecialCases(-_expr) <-- {-1,1}:FactorsMultivariateSpecialCases(expr);
-
-10 # FactorsMultivariateSpecialCases(x_IsAtom + y_IsAtom) <-- {{x+y,1}};
-
-10 # FactorsMultivariateSpecialCases(x_IsAtom - y_IsAtom) <-- {{x-y,1}};
-
-10 # FactorsMultivariateSpecialCases(n_IsInteger*_x + m_IsInteger*_y)_(Gcd(n,m)>1) <-- {{Gcd(n,m),1},{(Simplify((n*x+m*y)/Gcd(n,m))),1}};
-
-10 # FactorsMultivariateSpecialCases(n_IsInteger*_x - m_IsInteger*_y)_(Gcd(n,m)>1) <-- {{Gcd(n,m),1},{(Simplify((n*x-m*y)/Gcd(n,m))),1}};
-
-10 # FactorsMultivariateSpecialCases(_n*_x + _n*_y) <-- {n,1}:FactorsMultivariateSpecialCases(x+y);
-
-10 # FactorsMultivariateSpecialCases(_n*_x - _n*_y) <-- {n,1}:FactorsMultivariateSpecialCases(x-y);
-
-10 # FactorsMultivariateSpecialCases(_x^2-_y^2) <-- {{x+y,1},{x-y,1}};
-
-10 # FactorsMultivariateSpecialCases(_x^3-_y^3) <-- {{x-y,1},{x^2+y*x+y^2,1}};
-
-10 # FactorsMultivariateSpecialCases(_x^3+_y^3) <-- {{x+y,1},{x^2-y*x+y^2,1}};
-
-10 # FactorsMultivariateSpecialCases(_x^4-_y^4) <-- {{x+y,1},{x-y,1},{x^2+y^2,1}};
-
-10 # FactorsMultivariateSpecialCases(_x^6-_y^6) <-- {{x+y,1},{x-y,1},{x^2+x*y+y^2,1},{x^2-x*y+y^2,1}};
-
-20 # FactorsSomethingElse(_p) <--
- [
- If( InVerboseMode(),
- [
- ECHO(" *** FactorsSomethingElse: NOT IMPLEMENTED YET ***");
- ]
- );
- p;
- ];
-
-//------------------------------------------------------------------------
-
-
-10 # CombineNumericalFactors( factrs_IsList ) <--
- [
- If( InVerboseMode(), Tell("Combine",factrs) );
- Local(q,a,b,t,f,err);
- err := False;
- t := 1;
- f := {};
- ForEach(q,factrs)
- [
- If( InVerboseMode(), Tell(1,q) );
- If( IsList(q) And Length(q)=2,
- [
- {a,b} := q;
- If( InVerboseMode(), Echo(" ",{a,b}) );
- If( IsNumericList( {a,b} ),
- t := t * a^b,
- f := {a,b}:f
- );
- ],
- err := True
- );
- ];
- If( InVerboseMode(),
- [
- Echo(" t = ",t);
- Echo(" f = ",f);
- Echo(" err = ",err);
- ]
- );
- If(Not err And t != 1, {t,1}:Reverse(f), factrs);
- ];
-
-//---------------------------------------------------------------------
-%/mathpiper
-
-
-
-
-
-
-%mathpiper_docs,name="Factors",categories="User Functions;Number Theory"
-*CMD Factors --- factorization
-*STD
-*CALL
- Factors(x)
-
-*PARMS
-
-{x} -- integer or univariate polynomial
-
-*DESC
-
-This function decomposes the integer number {x} into a product of
-numbers.
-Alternatively, if {x} is a univariate polynomial, it is
-decomposed into irreducible polynomials. If {x} is a polynomial
-"over the integers", the irreducible polynomial factors will also
-be returned in the (unique) form with integer coefficients.
-
-The factorization is returned as a list of pairs. The first member of
-each pair is the factor, while the second member denotes the power to
-which this factor should be raised. So the factorization
-$x = p1^n1 * ... * p9^n9$
-is returned as {{{p1,n1}, ..., {p9,n9}}}.
-
-Programmer: Yacas Team + Sherm Ostrowsky
-
-*E.G.
- In> Factors(24)
- Result: {{2,3},{3,1}}
-
- In> Factors(32*x^3+32*x^2-70*x-75)
- Result: {{4*x+5,2},{2*x-3,1}}
-
-*SEE Factor, IsPrime, GaussianFactors
-%/mathpiper_docs
-
- %output,preserve="false"
-
-. %/output
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FactorsPolynomialOverIntegers.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FactorsPolynomialOverIntegers.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FactorsPolynomialOverIntegers.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FactorsPolynomialOverIntegers.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,205 +0,0 @@
-%mathpiper,def="FactorsPolynomialOverIntegers",scope="private"
-
-Retract("FactorsPolynomialOverIntegers",*);
-Retract("TryToReduceSpecialPolynomial",*);
-
-//---------------------------------------------------------------------------
-
-10 # FactorsPolynomialOverIntegers(_expr)_IsPolynomialOverIntegers(expr) <--
-[
- Local(x);
- x := VarList(expr)[1];
- FactorsPolynomialOverIntegers(expr,x);
-
-];
-
-15 # FactorsPolynomialOverIntegers(_expr) <-- expr;
-
-
-10 # FactorsPolynomialOverIntegers(_expr,_var)_(IsPolynomialOverIntegers(expr,var)) <--
-[
- Local(factorsList,factListTransp,factrs,multiplicities,factrsUnMonic);
- Local(polyFactors,normalizations,normDivisor,polyFactors,factList);
- Local(n,result,newResult,gtotal,r,rr,d,g);
- factorsList := BinaryFactors(expr);
- /*
- * BinaryFactors is the internal MathPiper function that
- * creates a double list of factors and their multiplicities
- */
-
- // By transposing factorsList (which has the form of a list of
- // lists, hence a matrix), we convert it into a form which has
- // a list of all the factors first, followed by a list of all
- // the corresponding multiplicities.
-
- factListTransp := Transpose(factorsList);
- factrs := factListTransp[1];
- multiplicities := factListTransp[2];
-
- // Now, these factors are probably all in "monic" form, with the
- // coefficient of the highest power of x in each factor being
- // equal to 1, and all the "normalizing" factors being combined
- // into a new leading numeric factor. We want to undo this
- // monic-ization. The function Together() will accomplish this
- // for each separate factor, while leaving untouched factors
- // which do not need changing.
-
- factrsUnMonic := MapSingle("Together",factrs);
-
- // The result of this step is that each factor which had been
- // "normalized" to a monic has now be un-normalized into a
- // rational function consisting of a non-monic polynomial
- // divided by a number. Now we just collect all the non-monic
- // polynomials into one list, and all the normalizing denominators
- // into another.
-
- {polyFactors,normalizations}:=Transpose(MapSingle("GetNumerDenom",factrsUnMonic));
-
- // The next step is to make sure that each of the normalizing
- // numbers is raised to the power of its corresponding
- // multiplicity. Then all these powers of numbers are
- // multiplied together, to form the overall normilizing
- // divisor which must be used to remove the extra factor (if
- // any) introduced during the monic-ization process. All this
- // is condensed into one line of Functional code
-
- normDivisor := Product(Map("^",{normalizations,multiplicities}));
-
- // Notice that normDivisors is exactly equal in value to the
- // 'extra' numeric factor introduced by the monic-ization, if
- // any was indeed so introduced (it doesn't happen under all
- // circumstances). I believe this will always be true, but I
- // have not taken the time to prove it. So I proceed in a
- // more general way.
-
- polyFactors[1] := Simplify(polyFactors[1]/normDivisor);
-
- // We can now replace the first sub-list in factListTransp by
- // the un-monic-ized version
-
- factListTransp[1] := polyFactors;
- factList := Transpose(factListTransp);
-
-
- // .... and that is (supposedly) the answer.
- result := factList;
-
- // However, let's find out if any of the factors needs more treatment.
- Local(newResult,gtotal,d,g,rr);
- newResult := {};
- gtotal := 1;
- ForEach(r,result) [
- d := Degree(r[1],var);
- g := Gcd(Coef(r[1],var,0 .. d));
- If( g > 1, // need to remove common numerical factor
- [ gtotal:=g*gtotal;
- r[1]:=Simplify(r[1]/g);
- ]
- );
- If(d > 2,
- [
- // polynomial is NOT irreducible, but can we reduce it?
- rr := TryToReduceSpecialPolynomial(r[1]);
- If( IsList(rr),newResult := Concat(newResult,rr) );
- ],
- If( r != {1,1}, newResult := r:newResult )
- );
- ];
- If(gtotal>1,newResult:={gtotal,1}:newResult);
- newResult;
-];
-
-
-//---------------------------------------------------------------------------
-// S P E C I A L C A S E S
-//---------------------------------------------------------------------------
-/*
- * Given an unreduced polynomial over the integers, of degree > 2,
- * which was found as one of the "factors" of a polynomial over
- * the integers, we know that it is factorable into irreducible
- * quadratics. This function tries to find such quadratic factors.
- * Lacking a good general attack on this problem, we will turn
- * to special cases which we happen to be able to solve.
- */
-
-10 # TryToReduceSpecialPolynomial(_x^4+_x^2+1) <-- {{x^2+x+1,1},{x^2-x+1,1}};
-
-10 # TryToReduceSpecialPolynomial(_x^6-1) <-- {{x+1,1},{x-1,1},{x^2+x+1,1},{x^2-x+1,1}};
-
-
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-
-
-
-
-%mathpiper_docs,name="FactorsPolynomialOverIntegers",categories="User Functions;Factors"
-*CMD Factors --- factorization of univariate polynomials over the integers
-*STD
-*CALL
- FactorsPolynomialOverIntegers(poly,x)
-
-*PARMS
-
-{poly} -- a polynomial which is univariate w.r.t. variable x
-{x} -- variable of the polynomial
-
-*DESC
-
-This function decomposes the polynomial {poly}, considered as univariate
-in the variable {x}, into a product of irreducible polynomials.
-
-This function is specialized for polynomials in {x} whose coefficients
-are all integers. In such a case, it is often customary to expect the
-irreducible polynomial factors to be given in a form which also has
-only integer coefficients. However, the standard MathPiper function
-Factors() follows a different convention, which returns the constituant
-polynomial factors in a {monic} form. This means that the results may
-have rational, rather than integer, coefficients.
-
-The present function offers an alternative which is guaranted to return
-polynomial factors with integer coefficients. But it works only for
-input {polynomials}, not {numbers}, and only for polynomials all of whose
-coefficients are integers. For any other input, this function will simply
-return the input expression unevaluated.
-
-The factorization is returned as a list of pairs. The first member of
-each pair is the factor, while the second member denotes the power to
-which this factor should be raised. So the factorization
-$poly = p1^n1 * ... * p9^n9$
-is returned as {{{p1,n1}, ..., {p9,n9}}}.
-
-NOTE: If you want the factorization to be expressed in the nominal
-form $poly = p1^n1 * ... * p9^n9$,
-just apply the function FW() to the result returned by the present
-function.
-
-Programmer: Sherm Ostrowsky
-
-*E.G.
-
-In> u:=Expand((2*x-3)^2*(3*x+5)^3)
-Result: 108*x^5+216*x^4-477*x^3-985*x^2+525*x+1125
-
-In> FactorsPolynomialOverIntegers(u,x)
-Result: {{2*x-3,2},{3*x+5,3}}
-
-In> FW(%)
-Result: (2*x-3)^2*(3*x+5)^3
-
-In> FactorsPolynomialOverIntegers(y^2-4)
-Result: {{y+2,1},{y-2,1}}
-
-In> FactorsPolynomialOverIntegers(x^4+x^2+1)
-Result: {{x^2+x+1,1},{x^2-x+1,1}}
-
-*SEE Factor, Factors, FW
-%/mathpiper_docs
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FindPrimeFactor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FindPrimeFactor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FindPrimeFactor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FindPrimeFactor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="FindPrimeFactor"
-
-// numbers
-
-/// Auxiliary function. Return the power of a given prime contained in a given integer and remaining integer.
-/// E.g. FindPrimeFactor(63, 3) returns {7, 2} and FindPrimeFactor(42,17) returns {42, 0}
-// use variable step loops, like in IntLog()
-FindPrimeFactor(n, prime) :=
-[
- Local(power, factor, old'factor, step);
- power := 1;
- old'factor := 1; // in case the power should be 0
- factor := prime;
- // first loop: increase step
- While(Mod(n, factor)=0) // avoid division, just compute Mod()
- [
- old'factor := factor; // save old value here, avoid sqrt
- factor := factor^2;
- power := power*2;
- ];
- power := Div(power,2);
- factor := old'factor;
- n := Div(n, factor);
- // second loop: decrease step
- step := Div(power,2);
- While(step>0 And n > 1)
- [
- factor := prime^step;
- If(
- Mod(n, factor)=0,
- [
- n := Div(n, factor);
- power := power + step;
- ]
- );
- step := Div(step, 2);
- ];
- {n, power};
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FindPrimeFactorSimple.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FindPrimeFactorSimple.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FindPrimeFactorSimple.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FindPrimeFactorSimple.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="FindPrimeFactorSimple"
-
-// numbers
-
-/* simpler method but slower on worstcase such as p^n or n! */
-FindPrimeFactorSimple(n, prime) :=
-[
- Local(power, factor);
- power := 0;
- factor := prime;
- While(Mod(n, factor)=0)
- [
- factor := factor*prime;
- power++;
- ];
- {n/(factor/prime), power};
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FWatom.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FWatom.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FWatom.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FWatom.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-%mathpiper,def="FWatom",scope="private"
-
-10 # FWatom({_a,1}) <-- a;
-20 # FWatom({_a,_n}) <-- UnList({Atom("^"),a, n});
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FW.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FW.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/FW.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/FW.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-%mathpiper,def="FW"
-
-/* FW: pass FW the result of Factors, and it will show it in the
- * form of p0^n0*p1^n1*...
- */
-
-
-5 # FW(_list)_(Length(list) = 0) <-- 1;
-10 # FW(_list)_(Length(list) = 1) <-- FWatom(list[1]);
-20 # FW(_list) <--
-[
- Local(result);
- result:=FWatom(First(list));
- ForEach(item,Rest(list))
- [
- result := UnList({ Atom("*"),result,FWatom(item)});
- ];
- result;
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardCombineLists.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardCombineLists.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardCombineLists.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardCombineLists.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-%mathpiper,def="PollardCombineLists",scope="private"
-/* PollardCombineLists combines two assoc lists used for factoring.
- the first element in each item list is the factor, and the second
- the exponent. Thus, an assoc list of {{2,3},{3,5}} means 2^3*3^5.
-*/
-PollardCombineLists(_left,_right) <--
-[
- ForEach(item,right)
- [
- PollardMerge(left,item);
- ];
- left;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardMerge.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardMerge.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardMerge.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardMerge.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-%mathpiper,def="PollardMerge",scope="private"
-
-5 # PollardMerge(_list,{1,_n}) <-- True;
-10 # PollardMerge(_list,_item)_(Assoc(item[1],list) = Empty) <--
- DestructiveInsert(list,1,item);
-
-20 # PollardMerge(_list,_item) <--
-[
- Local(assoc);
- assoc := Assoc(item[1],list);
- assoc[2]:=assoc[2]+item[2];
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardRhoFactorize.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardRhoFactorize.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/pollardrho/PollardRhoFactorize.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/pollardrho/PollardRhoFactorize.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,73 +0,0 @@
-%mathpiper,def="PollardRhoFactorize",scope="private"
-
-/* This is Pollard's Rho method of factorizing, as described in
- * "Modern Computer Algebra". It is a rather fast algorithm for
- * factoring, but doesn't scale to polynomials regrettably.
- *
- * It acts 'by chance'. This is the Floyd cycle detection trick, where
- * you move x(i+1) = f(x(i)) and y(i+1) = f(f(y(i))), so the y goes twice
- * as fast as x, and for a certain i x(i) will be equal to y(i).
- *
- * "Modern Computer Algebra" reasons that if f(x) = (x^2+1) mod n for
- * the value n to be factored, then chances are good that gcd(x-y,n)
- * is a factor of n. The function x^2+1 is arbitrary, a higher order
- * polynomial could have been chosen also.
- *
- */
-
-/*
-Warning: The Pollard Rho algorithm cannot factor some numbers, e.g. 703, and
-can enter an infinite loop. This currently results in an error message: "failed to factorize".
-Hopefully the TrialFactorize() step will avoid these situations by excluding
-small prime factors.
-This problem could also be circumvented by trying a different random initial value for x when a loop is encountered -- hopefully another initial value will not get into a loop. (currently this is not implemented)
-*/
-
-
-
-
-/// Polynomial for the Pollard Rho iteration
-PollardRhoPolynomial(_x) <-- x^2+1;
-
-2# PollardRhoFactorize(n_IsPrimePower) <-- {GetPrimePower(n)};
-3# PollardRhoFactorize(_n) <--
-[
- Local(x,y,restarts,gcd,repeat);
- gcd:=1;
- restarts := 100; // allow at most this many restartings of the algorithm
- While(gcd = 1 And restarts>=0) // outer loop: this will be typically executed only once but it is needed to restart the iteration if it "stalls"
- [
- restarts--;
- /* Pick a random value between 1 and n-1 */
- x:= RandomInteger(n-1);
-
- /* Initialize loop */
- gcd:=1; y:=x;
- repeat := 4; // allow at most this many repetitions
-// Echo({"debug PollardRho: entering gcd loop, n=", n});
-
- /* loop until failure or success found */
- While(gcd = 1 And repeat>=0)
- [
- x:= Mod( PollardRhoPolynomial(x), n);
- y:= Mod( PollardRhoPolynomial(
- Mod( PollardRhoPolynomial(y), n) // this is faster for large numbers
- ), n);
- If(x-y = 0,
- [
- gcd := 1;
- repeat--; // guard against "stalling" in an infinite loop but allow a few repetitions
- ],
- gcd:=Gcd(x-y,n)
- );
-// Echo({"debug PollardRho: gcd=",gcd," x=", x," y=", y});
- ];
- If(InVerboseMode() And repeat<=0, Echo({"PollardRhoFactorize: Warning: stalled while factorizing ", n, "; counters ", x, y}));
- ];
- Check(restarts>0, "PollardRhoFactorize: Error: failed to factorize " : String(n));
- If(InVerboseMode() And gcd > 1, Echo({"PollardRhoFactorize: Info: while factorizing ", n, " found factor ", gcd}));
- /* Return result found */
- PollardCombineLists(PollardRhoFactorize(gcd), PollardRhoFactorize(Div(n,gcd)));
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Roots.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Roots.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/Roots.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/Roots.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-%mathpiper,def="Roots"
-
-// polynomials
-
-10 # Roots(poly_CanBeUni) <--
-[
- Local(factors,result,uni,root,i,deg);
- factors:=Factors(poly);
- result:={};
- ForEach(item,factors)
- [
- uni:=MakeUni(item[1]);
- deg:=Degree(uni);
- If(deg > 0 And deg < 3,
- [
- root:= PSolve(uni);
- If(Not IsList(root),root:={root});
- For(i:=0,i 0 And deg < 3,
- [
- root:= PSolve(uni);
- If(Not IsList(root),root:={root});
- For(i:=1,i<=Length(root),i++)
- result:= Concat({{root[i],item[2]}}, result);
- ]
- );
- ];
- result;
-];
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/SortFactorList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/SortFactorList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/factors/SortFactorList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/factors/SortFactorList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def="SortFactorList",scope="private"
-
-/// Sort the list of prime factors using HeapSort()
-LocalSymbols(a,b, list) [
-
-SortFactorList(list) := HeapSort(list, {{a,b}, a[1] 1,000,000.
-/// Try all prime factors up to Sqrt(n).
-/// Resulting factors are automatically sorted.
-/// This function is not used any more.
-/*
-2# TrialFactorize(n_IsPrimePower) <-- {GetPrimePower(n)};
-3# TrialFactorize(n_IsInteger) <--
-[
- Local(factorization);
- factorization := TrialFactorize(n, n); // TrialFactorize will limit to Sqrt(n) automatically
- If(
- First(factorization) = 1, // all factors were smaller than Sqrt(n)
- Rest(factorization),
- // the first element needs to be replaced
- Concat(Rest(factorization), {{First(factorization),1}})
- );
-];
-*/
-
-
-/// Auxiliary function. Factorizes by trials. Return prime factors up to given limit and the remaining number.
-/// E.g. TrialFactorize(42, 2) returns {21, {{2, 1}}} and TrialFactorize(37, 4) returns {37}
-TrialFactorize(n, limit) :=
-[
- Local(power, prime, result);
- result := {n}; // first element of result will be replaced by the final value of n
- prime := 2; // first prime
- While(prime <= limit And n>1 And prime*prime <= n)
- [ // find the max power of prime which divides n
- {n, power} := FindPrimeFactor(n, prime);
- If(
- power>0,
- DestructiveAppend(result, {prime,power})
- );
- prime := NextPseudoPrime(prime); // faster than NextPrime and we don't need real primes here
- ];
- // replace the first element which was n by the new n
- DestructiveReplace(result, 1, n);
-];
-
-
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/atsign_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/atsign_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/atsign_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/atsign_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="@"
-
-RuleBase("@",{func,arg});
-Rule("@",2,1,IsList(arg)) Apply(func,arg);
-Rule("@",2,2,True ) Apply(func,{arg});
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="@",categories="Operators"
-*CMD @ --- apply a function
-*STD
-*CALL
- fn @ arglist
-Precedence:
-*EVAL OpPrecedence("@")
-
-*PARMS
-
-{fn} -- function to apply
-
-{arglist} -- single argument, or a list of arguments
-
-*DESC
-
-This function is a shorthand for {Apply}. It applies the
-function "fn" to the argument(s) in "arglist" and returns the
-result. The first parameter "fn" can either be a string containing
-the name of a function or a pure function.
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> "Sin" @ a
- Out> Sin(a);
- In> {{a},Sin(a)} @ a
- Out> Sin(a);
- In> "f" @ {a,b}
- Out> f(a,b);
-
-*SEE Apply
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/colon_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/colon_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/colon_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/colon_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,59 +0,0 @@
-%mathpiper,def=":"
-
-/* Operators for functional programming. todo:tk:move some of this documentation into the proper function's .mrw files.
- * Examples:
- * a:b:c:{} -> {a,b,c}
- * "Sin" @ a -> Sin(a)
- * "Sin" @ {a,b} -> Sin(a,b)
- * "Sin" /@ {a,b} -> {Sin(a),Sin(b)}
- * 1 .. 4 -> {1,2,3,4}
- */
-
-
-/* a : b will now return unevaluated (rather than cause error of invalid argument in Concat) if neither a nor b is a list and if one of them is not a string
-*/
-RuleBase(":",{head,tail});
-Rule(":",2,20,IsList(head) And Not IsList(tail) ) Concat(head,{tail});
-Rule(":",2,30,IsList(tail) ) Concat({head},tail);
-Rule(":",2,10,IsString(tail) And IsString(head)) ConcatStrings(head,tail);
-UnFence(":",2);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name=":",categories="Operators"
-*CMD : --- prepend item to a list or concatenate strings
-*STD
-*CALL
- item : list
- string1 : string2
-Precedence:
-*EVAL OpPrecedence(":")
-
-*PARMS
-{item} -- an item to be prepended to a list
-
-{list} -- a list
-
-{string1} -- a string
-
-{string2} -- a string
-
-*DESC
-
-The first form prepends "item" as the first entry to the list
-"list". The second form concatenates the strings "string1" and
-"string2".
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> a:b:c:{}
- Out> {a,b,c};
- In> "This":"Is":"A":"String"
- Out> "ThisIsAString";
-
-*SEE Concat, ConcatStrings
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/dot_dot_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/dot_dot_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/dot_dot_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/dot_dot_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def=".."
-
-/*
-.. operator is implemented with the Table function.
-*/
-10 # (count'from_IsInteger .. count'to_IsInteger)_(count'from <= count'to)
- <-- Table(i,i,count'from,count'to,1);
-20 # (count'from_IsInteger .. count'to_IsInteger)
- <-- Table(i,i,count'from,count'to,-1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="..",categories="Operators"
-*CMD .. --- construct a list of consecutive integers
-
-*STD
-
-*CALL
- n .. m
-
-*PARMS
-
-{n} -- integer. the first entry in the list
-
-{m} -- integer, the last entry in the list
-
-*DESC
-
-This command returns the list {{n, n+1, n+2, ..., m}}. If {m} is
-smaller than {n}, the empty list is returned. Note that the
-{..} operator should be surrounded by spaces to keep the
-parser happy, if "n" is a number. So one should write "{1 .. 4}" instead of "{1..4}".
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> 1 .. 4
- Out> {1,2,3,4};
-
-*SEE Table
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/NFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/NFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/NFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/NFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,97 +0,0 @@
-%mathpiper,def="NFunction"
-
-/* NFunction("new'func", "old'func" {arg'list}) will define a wrapper function
-around "old'func", called "new'func", which will return "old'func(arg'list)"
-only when all arguments are numbers and will return unevaluated
-"new'func(arg'list)" otherwise. */
-LocalSymbols(NFunction'Numberize)
-[
-NFunction(new'name_IsString, old'name_IsString, arg'list_IsList) <-- [
- MacroRuleBase(new'name, arg'list);
- MacroRule(new'name, Length(arg'list), 0, // check whether all args are numeric
- UnList({IsNumericList, arg'list})
- )
-
- /* this is the rule defined for the new function.
- // this expression should evaluate to the body of the rule.
- // the body looks like this:
- // NFunction'Numberize(old'name(arg'list))
- */
- NFunction'Numberize(UnList({Atom("@"), old'name, arg'list}));
- // cannot use bare '@' b/c get a syntax error
-
-];
-
-// this function is local to NFunction.
-// special handling for numerical errors: return Undefined unless given a number.
-10 # NFunction'Numberize(x_IsNumber) <-- x;
-20 # NFunction'Numberize(x_IsAtom) <-- Undefined;
-// do nothing unless given an atom
-
-]; // LocalSymbols()
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="NFunction",categories="User Functions;Functional Operators"
-*CMD NFunction --- make wrapper for numeric functions
-*STD
-*CALL
- NFunction("newname","funcname", {arglist})
-
-*PARMS
-{"newname"} -- name of new function
-
-{"funcname"} -- name of an existing function
-
-{arglist} -- symbolic list of arguments
-
-*DESC
-This function will define a function named "newname"
-with the same arguments as an existing function named "funcname". The new function will evaluate and return the expression "funcname(arglist)" only when
-all items in the argument list {arglist} are numbers, and return unevaluated otherwise.
-
-This can be useful when plotting functions defined through other MathPiper routines that cannot return unevaluated.
-
-If the numerical calculation does not return a number (for example,
-it might return the atom {nan}, "not a number", for some arguments),
-then the new function will return {Undefined}.
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-
-*E.G. notest
- In> f(x) := N(Sin(x));
- Out> True;
- In> NFunction("f1", "f", {x});
- Out> True;
- In> f1(a);
- Out> f1(a);
- In> f1(0);
- Out> 0;
-Suppose we need to define a complicated function {t(x)} which cannot be evaluated unless {x} is a number:
-
- In> t(x) := If(x<=0.5, 2*x, 2*(1-x));
- Out> True;
- In> t(0.2);
- Out> 0.4;
- In> t(x);
- In function "If" :
- bad argument number 1 (counting from 1)
- CommandLine(1) : Invalid argument
-Then, we can use {NFunction()} to define a wrapper {t1(x)} around {t(x)} which will not try to evaluate {t(x)} unless {x} is a number.
-
- In> NFunction("t1", "t", {x})
- Out> True;
- In> t1(x);
- Out> t1(x);
- In> t1(0.2);
- Out> 0.4;
-Now we can plot the function.
-
- In> Plot2D(t1(x), -0.1: 1.1)
- Out> True;
-
-*SEE MacroRule
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef( ":" , "mathpiper","prepend" );
-OMDef( "@" , "mathpiper","apply" );
-OMDef( "/@" , "mathpiper","list_apply" );
-OMDef( ".." , "interval1","integer_interval" );
-OMDef( "NFunction", "mathpiper","NFunction" );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/slash_atsign_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/slash_atsign_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/functional/slash_atsign_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/functional/slash_atsign_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,40 +0,0 @@
-%mathpiper,def="/@"
-
-Function("/@",{func,lst}) Apply("MapSingle",{func,lst});
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="/@",categories="Operators"
-*CMD /@ --- apply a function to all entries in a list
-*STD
-*CALL
- fn /@ list
-Precedence:
-*EVAL OpPrecedence("/@")
-
-*PARMS
-
-{fn} -- function to apply
-
-{list} -- list of arguments
-
-*DESC
-This function is a shorthand for {MapSingle}. It
-successively applies the function "fn" to all the entries in
-"list" and returns a list contains the results. The parameter "fn"
-can either be a string containing the name of a function or a pure
-function.
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> "Sin" /@ {a,b}
- Out> {Sin(a),Sin(b)};
- In> {{a},Sin(a)*a} /@ {a,b}
- Out> {Sin(a)*a,Sin(b)*b};
-
-*SEE MapSingle, Map, MapArgs
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/html/html.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/html/html.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/html/html.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/html/html.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,252 +0,0 @@
-%mathpiper,def="HtmlNewParagraph;HtmlAnchor;HtmlLink;HtmlTable;HtmlCaption;HtmlTitle;HtmlFrameSetRows;HtmlFrameSetCols;HtmlFrame;HtmlTag;HtmlForm;Bullets;Bullet;HtmlTextArea;HtmlTextField;HtmlSubmitButton;SetHtmlDirectory;HtmlFile;ClearSite;LoadSite;SaveSite;MySQLQuery"
-
-/* def file definitions
-HtmlNewParagraph
-HtmlAnchor
-HtmlLink
-HtmlTable
-HtmlCaption
-HtmlTitle
-HtmlFrameSetRows
-HtmlFrameSetCols
-HtmlFrame
-HtmlTag
-HtmlForm
-Bullets
-Bullet
-HtmlTextArea
-HtmlTextField
-HtmlSubmitButton
-SetHtmlDirectory
-HtmlFile
-ClearSite
-LoadSite
-SaveSite
-MySQLQuery
-*/
-
-
-/* code to generate html */
-
-
-/* Global defines */
-anchor:={};
-anchor["0"]:="a";
-anchor["name"]:="";
-
-link:={};
-link["0"]:="a";
-link["href"]:="";
-
-frameset:={};
-frameset["0"]:="frameset";
-frameset["border"]:="0";
-
-frame:={};
-frame["0"]:="frame";
-
-caption:={};
-caption["0"]:="caption";
-
-table:={};
-table["0"]:="table";
-
-form:={};
-form["0"]:="form";
-
-textarea:={};
-textarea["0"]:="textarea";
-
-textfield:={};
-textfield["0"]:="input";
-textfield["TYPE"]:="text";
-
-button:={};
-button["0"]:="input";
-button["TYPE"]:="submit";
-
-bullets:={};
-bullets["0"]:="ul";
-
-bullet:={};
-bullet["0"]:="li";
-
-newline:="
-";
-Gt():=">";
-Lt():="<";
-
-
-
-
-HtmlNewParagraph():= (newline : "
" : newline);
-
-HtmlTitle(title):=
-[
-"
- " : title : "
-
-";
-];
-
-HtmlAnchor(name):=
-[
- anchor["name"]:=name;
- HtmlTag(anchor,"");
-];
-Bodied("HtmlAnchor",60000);
-
-HtmlTable(cellpadding,width,body):=
-[
- table["cellpadding"]:=String(cellpadding);
- table["width"]:=width;
- HtmlTag(table,body);
-];
-
-Bullets(list):=HtmlTag(bullets,list);
-Bullet (list):=HtmlTag(bullet ,list);
-
-
-HtmlCaption(title):=
-[
- HtmlTag(caption,title);
-];
-
-HtmlForm(action,body):=
-[
- form["method"]:="get";
- form["action"]:=action;
- HtmlTag(form,body);
-];
-
-
-HtmlTextArea(name,width,height,body) :=
-[
- textarea["name"]:=name;
- textarea["cols"]:=String(width);
- textarea["rows"]:=String(height);
- HtmlTag(textarea,body);
-];
-
-HtmlTextField(name,size,value):=
-[
- textfield["name"]:=name;
- textfield["size"]:=String(size);
- textfield["value"]:=value;
- HtmlTag(textfield,"");
-];
-
-HtmlSubmitButton(name,value):=
-[
- button["name"]:=name;
- button["value"]:=value;
- HtmlTag(button,"");
-];
-
-
-HtmlLink(description,file,tag,target):=
-[
- If(tag != "",
- link["href"]:= file : "#" : tag,
- link["href"]:= file);
-
- If(target != "",link["target"] :=target);
- HtmlTag(link,description);
-];
-
-HtmlFrameSetRows(columns,body):=
-[
- frameset["cols"]:="";
- frameset["rows"]:=columns;
- HtmlTag(frameset,body);
-];
-
-HtmlFrameSetCols(columns,body):=
-[
- frameset["cols"]:=columns;
- frameset["rows"]:="";
- HtmlTag(frameset,body);
-];
-
-HtmlFrame(source,name):=
-[
- frame["src"]:=source;
- frame["name"]:=name;
- HtmlTag(frame,"");
-];
-
-
-/* export a html tag type, using the specifications in the
- tags assoc list.
- */
-HtmlTag(tags,content):=
-[
- Local(result,tag,analytics);
- result:="<" : tags["0"];
- ForEach(tag,AssocIndices(tags))
- [
- If (tag != "0" And tags[tag] != "",
- result:= result : " " : tag : "=" : "\"" : tags[tag] : "\""
- );
- ];
-
- analytics:="";
- If(tags["0"] = "body",
- analytics:="
-
-");
-
-
- result:= result : ">" : newline :
- content : newline :
- analytics : "" : newline;
-
- result;
-];
-
-/* output directory management */
-htmldir:="";
-SetHtmlDirectory(dir):= [htmldir:=dir;];
-HtmlFile(file) := [htmldir : file;];
-
-
-/* loading and saving site info */
-site:={};
-ClearSite() := [site:={};];
-LoadSite():=
-[
- FromFile("siteall")
- [
- site:=Read();
- ];
-];
-
-SaveSite():=
-[
- ToFile("siteall")
- [
- Write(site);
- WriteString(";");
- ];
-];
-
-MySQLQuery(pidstr,string):=
-[
- Local(result);
- ToFile("sqlin":pidstr) WriteString(string);
- SystemCall("mysql mysql < ":"sqlin":pidstr:" > sqlout":pidstr);
- SystemCall(FindFile("tools/mysqlstubs"):" sqlout":pidstr:" sqlout_":pidstr);
- result:= FromFile("sqlout_":pidstr)Read();
- SystemCall("rm -rf sqlin":pidstr);
- SystemCall("rm -rf sqlout":pidstr);
- SystemCall("rm -rf sqlout_":pidstr);
- result;
-];
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/mathpiperinit/mathpiperinit.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/mathpiperinit/mathpiperinit.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/mathpiperinit/mathpiperinit.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/mathpiperinit/mathpiperinit.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,104 +0,0 @@
-%mathpiper,def=""
-
-
-
-/* This is the basic initialization file for MathPiper. It gets loaded
- * each time MathPiper is started. All the basic files are loaded.
- */
-
-/* Set up drivers, configurable in the .mpiperrc
- * Set(MultiNomialDriver,"org/mathpiper/assembledscripts/multivar.rep/sparsenomial.mpi");
- * or
- * Set(MultiNomialDriver,"org/mathpiper/assembledscripts/multivar.rep/partialdensenomial.mpi");
- */
-
-/* The truly required files (MathPiper NEEDS to load). */
-// syntax must be loaded first
-Use("org/mathpiper/assembledscripts/initialization.rep/stdopers.mpi");
-
-/* Set of functions to define very simple functions. There are scripts that can
- be compiled to plugins. So MathPiper either loads the plugin, or loads the
- scripts at this point. The functions in these plugins need to be defined with
- these "Defun" functions.
- */
-DefMacroRuleBase("Defun",{func,args,body});
-Rule("Defun",3,0,True)
-[
- Local(nrargs);
- Set(nrargs,Length(@args));
- Retract(@func, `(@nrargs));
- RuleBase(@func,@args);
- Local(fn,bd);
- Set(fn,Hold(@func)); Set(bd,Hold(@body));
- `Rule(@fn, @nrargs, 0,True)(@bd);
-];
-
-//TODO remove? Use("org/mathpiper/assembledscripts/base.rep/math.mpi");
-
-Use("org/mathpiper/assembledscripts/patterns.rep/code.mpi");
-// at this point <-- can be used
-
-Use("org/mathpiper/assembledscripts/deffunc.rep/code.mpi");
-
-// at this point := and Function() can be used
-
-Use("org/mathpiper/assembledscripts/constants.rep/code.mpi");
-Use("org/mathpiper/assembledscripts/initialization.rep/standard.mpi");
-Use("org/mathpiper/assembledscripts/initialization.rep/stdarith.mpi");
-
-// at this point arithmetic can be used
-
-/* Load the def files for the other modules. The def files contain lists
- * of functions defined in that file. So, in solve.def you can find the
- * functions defined in the file solve. Each time a function is invoked
- * for which the interpreter can not find a definition, the file is loaded.
- */
-
-RuleBase(LoadPackages,{packages});
-Rule(LoadPackages, 1, 1, True)
-[
- If(Equals(packages,{}), True,
- [
- DefLoad(First(packages));
- LoadPackages(Rest(packages));
- ]);
-];
-
-Use("org/mathpiper/assembledscripts/initialization.rep/packages.mpi");
-LoadPackages(DefFileList());
-
-
-/* The read-eval-print loop */
-RuleBase("REP",{});
-LocalSymbols(input,stringOut,result,errorString)
-Rule("REP",0,1,True)
-[
- Local(input,stringOut,result);
- While(Not(IsExitRequested()))
- [
- Set(errorString, "");
- If(And(IsString(PrettyReader'Get()),Not(PrettyReader'Get() = "")),
- TrapError(Set(input, FromString(ReadCmdLineString("In> "))ApplyPure(PrettyReader'Get(),{})),Set(errorString,GetCoreError())),
- TrapError(Set(input, FromString(ConcatStrings(ReadCmdLineString("In> "),";"))Read()),Set(errorString,GetCoreError())));
- If(Not(errorString = ""), WriteString(errorString));
- If (Not(IsExitRequested()) And errorString="",
- [
- Set(stringOut,"");
- Set(result,False);
- Set(stringOut,ToString()[TrapError(Set(result,Eval(input)),Set(errorString,GetCoreError()));]);
- If(Not(stringOut = ""), WriteString(stringOut));
- If(Not(errorString = ""), WriteString(errorString));
- SetGlobalLazyVariable(%,result);
- If(PrettyPrinter'Get()="",
- [
- Write(Atom("Out> "),result);
- NewLine();
- ],
- Apply(PrettyPrinter'Get(),{result}));
- ]);
- ];
-];
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/miscdocs/miscellaneousdocs.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/miscdocs/miscellaneousdocs.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/miscdocs/miscellaneousdocs.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/miscdocs/miscellaneousdocs.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,221 +0,0 @@
-
-
-%mathpiper_docs,name="quit;restart",categories="User Functions;Built In"
-*CMD quit --- stop MathPiper from running (from the command line)
-*CMD restart --- restart MathPiper (to start with a clean slate)
-*CORE
-*CALL
- quit
- restart
-
-*DESC
-
-Type {quit} or {restart} at the MathPiper prompt to exit or to restart the interpreter.
-
-The directives {quit} and {restart} are not reserved words or variable names.
-They take effect only when typed as first characters at a prompt.
-
-Pressing {Ctrl-C} will stop the currently running calculation.
-If there is no currently running calculation, {Ctrl-C} will quit the interpreter.
-
-When the interpreter quits, it saves the command history
-(so quitting by {Ctrl-C} does not mean a "crash").
-
-This command is not a function but a special directive that only applies while running MathPiper interactively. It should not be used in scripts.
-
-*E.G.
-
-To be effective, the directive must be typed immediately after the prompt:
- In> quit
- Quitting...
-We can use variables named {quit}:
- In> 1+quit
- Out> quit+1;
-There is no effect if we type some spaces first:
- In> restart
- Out> restart;
-
-*SEE Exit
-%/mathpiper_docs
-
-
-
-
-%mathpiper_docs,name="%_v2",categories="Operators"
-*CMD % --- previous result
-*CORE
-*CALL
- %
-
-*DESC
-
-{%} evaluates to the previous result on the command line. {%} is a global
-variable that is bound to the previous result from the command line.
-Using {%} will evaluate the previous result. (This uses the functionality
-offered by the {SetGlobalLazyVariable} command).
-
-Typical examples are {Simplify(%)} and {PrettyForm(%)} to simplify and show the result in a nice
-form respectively.
-
-*E.G.
-
- In> Taylor(x,0,5)Sin(x)
- Out> x-x^3/6+x^5/120;
- In> PrettyForm(%)
-
- 3 5
- x x
- x - -- + ---
- 6 120
-
-
-
-*SEE SetGlobalLazyVariable
-%/mathpiper_docs
-
-
-
-
-
-
-%mathpiper_docs,name="True;False",categories="User Functions;Constants (System)"
-*CMD True --- boolean constant representing true
-*CMD False --- boolean constant representing false
-*CORE
-*CALL
- True
- False
-
-*DESC
-
-{True} and {False} are typically a result
-of boolean expressions such as {2 < 3} or {True And False}.
-
-*SEE And, Or, Not
-%/mathpiper_docs
-
-
-
-
-
-
-%mathpiper_docs,name="EndOfFile",categories="User Functions;Constants (System)"
-*CMD EndOfFile --- end-of-file marker
-*CORE
-*CALL
- EndOfFile
-
-*DESC
-
-End of file marker when reading from file. If a file
-contains the expression {EndOfFile;} the
-operation will stop reading the file at that point.
-%/mathpiper_docs
-
-
-
-
-
-%mathpiper_docs,name="Infinity",categories="User Functions;Constants (Mathematical)"
-
-*CMD Infinity --- constant representing mathematical infinity
-*STD
-*CALL
- Infinity
-
-*DESC
-
-Infinity represents infinitely large values. It can be the result of certain
-calculations.
-
-Note that for most analytic functions MathPiper understands {Infinity} as a positive number.
-Thus {Infinity*2} will return {Infinity}, and {a < Infinity} will evaluate to {True}.
-
-*E.G.
-
- In> 2*Infinity
- Out> Infinity;
- In> 2 True;
-%/mathpiper_docs
-
-
-
-
-
-%mathpiper_docs,name="Undefined",categories="User Functions;Constants (Mathematical)"
-*CMD Undefined --- constant signifying an undefined result
-*STD
-*CALL
- Undefined
-
-*DESC
-
-{Undefined} is a token that can be returned by a function when it considers
-its input to be invalid or when no meaningful answer can be given. The result is then "undefined".
-
-Most functions also return {Undefined} when evaluated on it.
-
-*E.G.
-
- In> 2*Infinity
- Out> Infinity;
- In> 0*Infinity
- Out> Undefined;
- In> Sin(Infinity);
- Out> Undefined;
- In> Undefined+2*Exp(Undefined);
- Out> Undefined;
-
-*SEE Infinity
-%/mathpiper_docs
-
-
-
-
-%mathpiper_docs,name="/*;*/;//",categories="Operators"
-*CMD /* --- Start of comment
-*CMD */ --- end of comment
-*CMD // --- Beginning of one-line comment
-*CORE
-*CALL
- /* comment */
- // comment
-
-*DESC
-
-Introduce a comment block in a source file, similar to C++ comments.
-{//} makes everything until the end of the line a comment, while {/*} and {*/} may delimit a multi-line comment.
-
-*E.G.
-
- a+b; // get result
- a + /* add them */ b;
-%/mathpiper_docs
-
-
-
-
-%mathpiper_docs,name="[;]",categories="Operators"
-*CMD [ --- beginning of block of statements
-*CMD ] --- end of block of statements
-*CORE
-*CALL
-
- [ statement1; statement2; ... ]
-
-*PARMS
-
-{statement1}, {statement2} -- expressions
-
-*DESC
-
-The {Prog} and the {[ ... ]} construct have the same effect: they evaluate all
-arguments in order and return the result of the last evaluated expression.
-
-{Prog(a,b);} is the same as typing {[a;b;];} and is very useful for writing out
-function bodies. The {[ ... ]} construct is a syntactically nicer version of the
-{Prog} call; it is converted into {Prog(...)} during the parsing stage.
-
-*SEE Prog
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/ampersand_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/ampersand_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/ampersand_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/ampersand_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="&"
-
-a_IsNonNegativeInteger & b_IsNonNegativeInteger <-- BitAnd(a,b);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="&",categories="Operators"
-*CMD --- bitwise AND operator
-*STD
-*CALL
- a & b
-
-*PARMS
-
-{a} -- non negative integer
-
-{b} -- non negative integer
-
-*DESC
-
-This operator performs a bitwise AND on two integers.
-
-*E.G.
-
-In> 15 & 4
-Result: 4
-
-*SEE |
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/A_Nth.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/A_Nth.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/A_Nth.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/A_Nth.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,100 +0,0 @@
-%mathpiper,def="Nth"
-
-/* Implementation of Nth that allows extending. */
-RuleBase("Nth",{alist,aindex});
-Rule("Nth",2,10,
- And(Equals(IsFunction(alist),True),
- Equals(IsInteger(aindex),True),
- Not(Equals(First(Listify(alist)),Nth))
- ))
- MathNth(alist,aindex);
-
-
-
-
-Rule("Nth",2,14,
- And(Equals(IsString(alist),True),IsList(aindex))
- )
-[
- Local(result);
- result:="";
- ForEach(i,aindex) [ result := result : StringMidGet(i,1,alist); ];
- result;
-];
-
-Rule("Nth",2,15,Equals(IsString(alist),True))
-[
- StringMidGet(aindex,1,alist);
-];
-
-
-Rule("Nth",2,20,Equals(IsList(aindex),True))
-[
- Map({{ii},alist[ii]},{aindex});
-];
-
-Rule("Nth",2,30,
- And(
- Equals(IsGeneric(alist),True),
- Equals(GenericTypeName(alist),"Array"),
- Equals(IsInteger(aindex),True)
- )
- )
-[
- ArrayGet(alist,aindex);
-];
-
-
-
-Rule("Nth",2,40,Equals(IsString(aindex),True))
-[
- Local(as);
- as := Assoc(aindex,alist);
- If (Not(Equals(as,Empty)),Set(as,Nth(as,2)));
- as;
-];
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Nth",categories="User Functions;Lists (Operations)"
-*CMD Nth --- return the $n$-th element of a list
-*CORE
-*CALL
- Nth(list, n)
-
-*PARMS
-
-{list} -- list to choose from
-
-{n} -- index of entry to pick
-
-*DESC
-
-The entry with index "n" from "list" is returned. The first entry
-has index 1. It is possible to pick several entries of the list by
-taking "n" to be a list of indices.
-
-More generally, {Nth} returns the n-th operand of the
-expression passed as first argument.
-
-An alternative but equivalent form of {Nth(list, n)} is
-{list[n]}.
-
-*E.G.
-
- In> lst := {a,b,c,13,19};
- Out> {a,b,c,13,19};
- In> Nth(lst, 3);
- Out> c;
- In> lst[3];
- Out> c;
- In> Nth(lst, {3,4,1});
- Out> {c,13,a};
- In> Nth(b*(a+c), 2);
- Out> a+c;
-
-*SEE Select, Nth
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/B_NrArgs.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/B_NrArgs.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/B_NrArgs.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/B_NrArgs.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="NrArgs"
-
-Function("NrArgs",{aLeft}) Length(Listify(aLeft))-1;
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="NrArgs",categories="User Functions;Lists (Operations)"
-*CMD NrArgs --- return number of top-level arguments
-*STD
-*CALL
- NrArgs(expr)
-
-*PARMS
-
-{expr} -- expression to examine
-
-*DESC
-
-This function evaluates to the number of top-level arguments of the
-expression "expr". The argument "expr" may not be an atom, since
-that would lead to an error.
-
-*E.G.
-
- In> NrArgs(f(a,b,c))
- Out> 3;
- In> NrArgs(Sin(x));
- Out> 1;
- In> NrArgs(a*(b+c));
- Out> 2;
-
-*SEE Type, Length
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/Denominator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/Denominator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/Denominator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/Denominator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="Denominator"
-
-1 # Denominator(_x / _y) <-- y;
-2 # Denominator(x_IsNumber) <-- 1;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Denominator",categories="User Functions;Numbers (Operations)"
-*CMD Denominator --- denominator of an expression
-*STD
-*CALL
- Denominator(expr)
-
-*PARMS
-
-{expr} -- expression to determine denominator of
-
-*DESC
-
-This function determines the denominator of the rational expression
-"expr" and returns it. As a special case, if its argument is numeric
-but not rational, it returns {1}. If "expr" is
-neither rational nor numeric, the function returns unevaluated.
-
-*E.G.
-
- In> Denominator(2/7)
- Out> 7;
- In> Denominator(a / x^2)
- Out> x^2;
- In> Denominator(5)
- Out> 1;
-
-*SEE Numerator, IsRational, IsNumber
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/equals_equals_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/equals_equals_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/equals_equals_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/equals_equals_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="=="
-
-RuleBase("==",{left,right});
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="==",categories="Operators"
-*CMD == --- symbolic equality operator
-*STD
-*CALL
- expression == expression
-
-*PARMS
-
-{expression} -- an expression
-
-*DESC
-
-This operator is used to symbolically represent the equality
-of two expressions as opposed to the = operator which performs
-a comparison operation on two expressions.
-
-*E.G.
-
-In> Solve(y == m*x + b, x)
-Result: {x==(y-b)/m}
-
-*SEE !==
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/exclamationpoint_equals_equals_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/exclamationpoint_equals_equals_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/exclamationpoint_equals_equals_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/exclamationpoint_equals_equals_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,28 +0,0 @@
-%mathpiper,def="!=="
-
-RuleBase("!==",{left,right});
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="!==",categories="Operators"
-*CMD !== --- symbolic inequality operator
-*STD
-*CALL
- expression !== expression
-
-*PARMS
-
-{expression} -- an expression
-
-*DESC
-
-This operator is used to symbolically represent the inequality
-of two expressions as opposed to the != operator which performs
-a comparison operation on two expressions.
-
-
-*SEE ==
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/IsNonObject.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/IsNonObject.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/IsNonObject.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/IsNonObject.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsNonObject"
-
-10 # IsNonObject(Object(_x)) <-- False;
-20 # IsNonObject(_x) <-- True;
-
-%/mathpiper
-
-
-
-
-
-%mathpiper_docs,name="IsNonObject",categories="User Functions;Predicates"
-*CMD IsNonObject --- test whether argument is not an {Object()}
-*STD
-*CALL
- IsNonObject(expr)
-
-*PARMS
-
-{expr} -- the expression to examine
-
-*DESC
-
-This function returns {True} if "expr" is not of
-the form {Object(...)} and {False}
-otherwise.
-
-*HEAD Bugs
-
-In fact, the result is always {True}.
-
-*SEE Object
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/minus_minus_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/minus_minus_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/minus_minus_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/minus_minus_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def="--"
-
-Function("--",{aVar})
-[
- MacroSet(aVar,SubtractN(Eval(aVar),1));
-];
-
-UnFence("--",1);
-
-HoldArg("--",aVar);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="--",categories="Operators"
-*CMD -- --- decrement variable
-*STD
-*CALL
- var--
-
-*PARMS
-
-{var} -- variable to decrement
-
-*DESC
-
-The variable with name "var" is decremented, i.e. the number 1 is
-subtracted from it. The expression {x--} is
-equivalent to the assignment {x := x - 1}, except
-that the assignment returns the new value of {x}
-while {x--} always returns true. In this respect,
-MathPiper' {--} differs from the corresponding operator
-in the programming language C.
-
-*E.G.
-
- In> x := 5;
- Out> 5;
- In> x--;
- Out> True;
- In> x;
- Out> 4;
-
-*SEE ++, :=
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/NormalForm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/NormalForm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/NormalForm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/NormalForm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-%mathpiper,def="NormalForm"
-
-RuleBase("NormalForm",{expression});
-Rule("NormalForm",1,1000,True) expression;
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="NormalForm",categories="User Functions;Lists (Operations)"
-*CMD NormalForm --- return expression in normal form
-*STD
-*CALL
- NormalForm(expression)
-
-*PARMS
-
-{expression} -- an expression
-
-*DESC
-
-This functions returns an expression in normal form.
-
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/Numerator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/Numerator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/Numerator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/Numerator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-%mathpiper,def="Numerator"
-
-1 # Numerator(_x / _y) <-- x;
-2 # Numerator(x_IsNumber) <-- x;
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="Numerator",categories="User Functions;Numbers (Operations)"
-*CMD Numerator --- numerator of an expression
-*STD
-*CALL
- Numerator(expr)
-
-*PARMS
-
-{expr} -- expression to determine numerator of
-
-*DESC
-
-This function determines the numerator of the rational expression
-"expr" and returns it. As a special case, if its argument is numeric
-but not rational, it returns this number. If "expr" is neither
-rational nor numeric, the function returns unevaluated.
-
-*E.G.
-
- In> Numerator(2/7)
- Out> 2;
- In> Numerator(a / x^2)
- Out> a;
- In> Numerator(5)
- Out> 5;
-
-*SEE Denominator, IsRational, IsNumber
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/numeric.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/numeric.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/numeric.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/numeric.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,216 +0,0 @@
-%mathpiper,def="N;NonN;InNumericMode"
-
-//"+-;/-;*-;^-;:=-;:=+" These were in the def list.
-
-/* See the documentation on the assignment of the precedence of the rules.
- */
-
-/* Some very basic functions that are used always any way... */
-
-
-
-
-
-
-
-/* Implementation of numeric mode */
-LocalSymbols(numericMode)
-[
-
- Set(numericMode, False);
-
-
- // N function: evaluate numerically with given precision.
- LocalSymbols(previousNumericMode, previousPrecision, numericResult) Macro("N",{expression, precision})
- [
- // we were in non-numeric mode
-
- Local(previousNumericMode, previousPrecision, numericResult, errorString);
-
- Set(previousPrecision, BuiltinPrecisionGet());
-
- BuiltinPrecisionSet(@precision);
-
- AssignCachedConstantsN();
-
- Set(previousNumericMode, numericMode);
-
- Set(numericMode, True);
-
- Set(errorString,"");
-
- TrapError(Set(numericResult, Eval(@expression)),Set(errorString,GetCoreError()));
-
- Set(numericMode,previousNumericMode);
-
- If(Not numericMode,
- [
- // clear constants
- ClearCachedConstantsN();
- ]);
-
- BuiltinPrecisionSet(previousPrecision);
-
- Check(errorString="",errorString);
-
- numericResult;
-
- ];
-
-
-
-
- // N function: evaluate numerically with default precision.
- LocalSymbols(precision,heldExpression) Macro("N",{expression})
- [
- Local(precision, heldExpression);
-
- Set(precision, BuiltinPrecisionGet());
-
- Set(heldExpression, Hold(@expression));
-
- `N(@heldExpression, @precision);
- ];
-
-
-
-
-
- // NoN function.
- LocalSymbols(result) Macro("NonN",{expression})
- [
- Local(result);
-
- GlobalPush(numericMode);
-
- numericMode := False;
-
- result := (@expression);
-
- numericMode := GlobalPop();
-
- result;
- ];
-
-
- // InNumericMode function.
- Function("InNumericMode",{}) numericMode;
-
-
-
-]; //LocalSymbols(numericMode)
-
-
-
-
-
-
-%/mathpiper
-
-
-
-
-
-
-%mathpiper_docs,name="N",categories="User Functions;Numbers (Operations)"
-*CMD N --- try to determine an numerical approximation of expression
-
-*STD
-*CALL
- N(expression)
- N(expression, precision)
-*PARMS
-
-{expression} -- expression to evaluate
-
-{precision} -- integer, precision to use
-
-*DESC
-
-The function {N} instructs {MathPiper} to try to coerce an expression in to a numerical approximation to the
-expression {expr}, using {prec} digits precision if the second calling
-sequence is used, and the default precision otherwise. This overrides the normal
-behaviour, in which expressions are kept in symbolic form (eg. {Sqrt(2)} instead of {1.41421}).
-
-Application of the {N} operator will make MathPiper
-calculate floating point representations of functions whenever
-possible. In addition, the variable {Pi} is bound to
-the value of $Pi$ calculated at the current precision.
-(This value is a "cached constant", so it is not recalculated each time {N} is used, unless the precision is increased.)
-
-
-{N} is a macro. Its argument {expr} will only
-be evaluated after switching to numeric mode.
-
-*E.G.
-
- In> 1/2
- Out> 1/2;
- In> N(1/2)
- Out> 0.5;
- In> Sin(1)
- Out> Sin(1);
- In> N(Sin(1),10)
- Out> 0.8414709848;
- In> Pi
- Out> Pi;
- In> N(Pi,20)
- Out> 3.14159265358979323846;
-
-*SEE Pi
-%/mathpiper_docs
-
-
-
-
-
-
-
-
-%mathpiper_docs,name="InNumericMode;NonN"
-*CMD InNumericMode --- determine if currently in numeric mode
-*CMD NonN --- calculate part in non-numeric mode
-
-*STD
-*CALL
- NonN(expr)
- InNumericMode()
-*PARMS
-
-{expr} -- expression to evaluate
-
-{prec} -- integer, precision to use
-
-*DESC
-
-When in numeric mode, {InNumericMode()} will return {True}, else it will
-return {False}. {MathPiper} is in numeric mode when evaluating an expression
-with the function {N}. Thus when calling {N(expr)}, {InNumericMode()} will
-return {True} while {expr} is being evaluated.
-
-{InNumericMode()} would typically be used to define a transformation rule
-that defines how to get a numeric approximation of some expression. One
-could define a transformation rule
-
- f(_x)_InNumericMode() <- [... some code to get a numeric approximation of f(x) ... ];
-
-{InNumericMode()} usually returns {False}, so transformation rules that check for this
-predicate are usually left alone.
-
-When in numeric mode, {NonN} can be called to switch back to non-numeric
-mode temporarily.
-
-{NonN} is a macro. Its argument {expr} will only
-be evaluated after the numeric mode has been set appropriately.
-
-*E.G.
-
- In> InNumericMode()
- Out> False
- In> N(InNumericMode())
- Out> True
- In> N(NonN(InNumericMode()))
- Out> False
-
-*SEE N, BuiltinPrecisionSet, BuiltinPrecisionGet, Pi, CachedConstant
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/percent_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/percent_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/percent_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/percent_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,31 +0,0 @@
-%mathpiper,def="%"
-
-a_IsNonNegativeInteger % b_IsPositiveInteger <-- Mod(a,b);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="%_v1",categories="Operators"
-*CMD % --- modulus operator
-*STD
-*CALL
- a % b
-
-*PARMS
-
-{a} -- non negative integer
-
-{b} -- non negative integer
-
-*DESC
-
-Divides a by b and returns the remainder of the division.
-
-*E.G.
-In> 8 % 5
-Result: 3
-
-*SEE /
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/plus_plus_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/plus_plus_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/plus_plus_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/plus_plus_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="++"
-
-Function("++",{aVar})
-[
- MacroSet(aVar,AddN(Eval(aVar),1));
-];
-
-UnFence("++",1);
-
-HoldArg("++",aVar);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="++",categories="Operators"
-*CMD ++ --- increment variable
-*STD
-*CALL
- var++
-
-*PARMS
-
-{var} -- variable to increment
-
-*DESC
-
-The variable with name "var" is incremented, i.e. the number 1 is
-added to it. The expression {x++} is equivalent to
-the assignment {x := x + 1}, except that the
-assignment returns the new value of {x} while {x++} always returns true. In this respect, MathPiper' {++} differs from the corresponding operator in the
-programming language C.
-
-*E.G.
-
- In> x := 5;
- Out> 5;
- In> x++;
- Out> True;
- In> x;
- Out> 6;
-
-*SEE --, :=
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/vertical_bar_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/vertical_bar_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/standard/vertical_bar_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/standard/vertical_bar_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="|"
-
-a_IsNonNegativeInteger | b_IsNonNegativeInteger <-- BitOr(a,b);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="|",categories="Operators"
-*CMD --- bitwise OR operator
-*STD
-*CALL
- a | b
-
-*PARMS
-
-{a} -- non negative integer
-
-{b} -- non negative integer
-
-*DESC
-
-This operator performs a bitwise OR on two integers.
-
-*E.G.
-
-In> 3 | 4
-Result: 7
-
-*SEE &
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/asterisk_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/asterisk_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/asterisk_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/asterisk_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,130 +0,0 @@
-%mathpiper,def="*"
-
-/* Multiplication */
-
-50 # x_IsNumber * y_IsNumber <-- MultiplyN(x,y);
-100 # 1 * _x <-- x;
-100 # _x * 1 <-- x;
-100 # (_f * _x)_(f= -1) <-- -x;
-100 # (_x * _f)_(f= -1) <-- -x;
-105 # (f_IsNegativeNumber * _x) <-- -(-f)*x;
-105 # (_x * f_IsNegativeNumber) <-- -(-f)*x;
-
-95 # x_IsMatrix * y_IsMatrix <--
-[
- Local(i,j,k,row,result);
- result:=ZeroMatrix(Length(x),Length(y[1]));
- For(i:=1,i<=Length(x),i++)
- For(j:=1,j<=Length(y),j++)
- For(k:=1,k<=Length(y[1]),k++)
- [
- row:=result[i];
- row[k]:= row[k]+x[i][j]*y[j][k];
- ];
- result;
-];
-
-
-96 # x_IsMatrix * y_IsList <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(x),i++)
- [ DestructiveInsert(result,i,x[i] . y); ];
- result;
-];
-
-
-97 # (x_IsList * y_IsNonObject)_Not(IsList(y)) <-- y*x;
-98 # (x_IsNonObject * y_IsList)_Not(IsList(x)) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(y),i++)
- [ DestructiveInsert(result,i,x * y[i]); ];
- result;
-];
-
-
-50 # _x * Undefined <-- Undefined;
-50 # Undefined * _y <-- Undefined;
-
-
-100 # 0 * Infinity <-- Undefined;
-100 # Infinity * 0 <-- Undefined;
-
-101 # 0 * (_x) <-- 0;
-101 # (_x) * 0 <-- 0;
-
-100 # x_IsNumber * (y_IsNumber * _z) <-- (x*y)*z;
-100 # x_IsNumber * (_y * z_IsNumber) <-- (x*z)*y;
-
-100 # (_x * _y) * _y <-- x * y^2;
-100 # (_x * _y) * _x <-- y * x^2;
-100 # _y * (_x * _y) <-- x * y^2;
-100 # _x * (_x * _y) <-- y * x^2;
-100 # _x * (_y / _z) <-- (x*y)/z;
-// fractions
-100 # (_y / _z) * _x <-- (x*y)/z;
-100 # (_x * y_IsNumber)_Not(IsNumber(x)) <-- y*x;
-
-100 # (_x) * (_x) ^ (n_IsConstant) <-- x^(n+1);
-100 # (_x) ^ (n_IsConstant) * (_x) <-- x^(n+1);
-100 # (_x * _y)* _x ^ n_IsConstant <-- y * x^(n+1);
-100 # (_y * _x)* _x ^ n_IsConstant <-- y * x^(n+1);
-
-105 # x_IsNumber * -(_y) <-- (-x)*y;
-105 # (-(_x)) * (y_IsNumber) <-- (-y)*x;
-
-106 # _x * -(_y) <-- -(x*y);
-106 # (- _x) * _y <-- -(x*y);
-
-107 # -( (-(_x))/(_y)) <-- x/y;
-107 # -( (_x)/(-(_y))) <-- x/y;
-
-
-250 # x_IsNumber * y_IsInfinity <-- Sign(x)*y;
-250 # x_IsInfinity * y_IsNumber <-- Sign(y)*x;
-
-
-/* Note: this rule MUST be past all the transformations on
- * matrices, since they are lists also.
- */
-230 # (aLeft_IsList * aRight_IsList)_(Length(aLeft)=Length(aRight)) <--
- Map("*",{aLeft,aRight});
-// fractions
-242 # (x_IsInteger / y_IsInteger) * (v_IsInteger / w_IsInteger) <-- (x*v)/(y*w);
-243 # x_IsInteger * (y_IsInteger / z_IsInteger) <-- (x*y)/z;
-243 # (y_IsInteger / z_IsInteger) * x_IsInteger <-- (x*y)/z;
-
-400 # (_x) * (_x) <-- x^2;
-
-%/mathpiper
-
-
-%mathpiper_docs,name="*",categories="Operators"
-*CMD * --- arithmetic multiplication
-*STD
-*CALL
-
- x*y
-Precedence:
-*EVAL OpPrecedence("*")
-
-*PARMS
-
-{x} and {y} -- objects for which arithmetic multiplication is defined
-
-*DESC
-
-The multiplication operator can work on integers,
-rational numbers, complex numbers, vectors, matrices and lists.
-
-This operator is implemented in the standard math library (as opposed
-to being built-in). This means that they can be extended by the user.
-
-*E.G.
-
- In> 2*3
- Out> 6;
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/caret_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/caret_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/caret_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/caret_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,115 +0,0 @@
-%mathpiper,def="^"
-
-/* Faster version of raising power to 0.5 */
-50 # _x ^ (1/2) <-- Sqrt(x);
-50 # (x_IsPositiveNumber ^ (1/2))_IsInteger(SqrtN(x)) <-- SqrtN(x);
-58 # 1 ^ n_IsInfinity <-- Undefined;
-59 # _x ^ 1 <-- x;
-59 # 1 ^ _n <-- 1;
-59 # x_IsZero ^ y_IsZero <-- Undefined;
-60 # (x_IsZero ^ n_IsRationalOrNumber)_(n>0) <-- 0;
-60 # (x_IsZero ^ n_IsRationalOrNumber)_(n<0) <-- Infinity;
-// This is to fix:
-// In> 0.0000^2
-// Out> 0.0000^2;
-// In> 0.0^2/2
-// Out> 0.0^2/2;
-//60 # (x_IsNumber ^ n_IsRationalOrNumber)_(x+1=1) <-- 0;
-
-59 # _x ^ Undefined <-- Undefined;
-59 # Undefined ^ _x <-- Undefined;
-
-/* Regular raising to the power. */
-61 # Infinity ^ (y_IsNegativeNumber) <-- 0;
-61 # (-Infinity) ^ (y_IsNegativeNumber) <-- 0;
-//61 # x_IsPositiveNumber ^ y_IsPositiveNumber <-- PowerN(x,y);
-//61 # x_IsPositiveNumber ^ y_IsNegativeNumber <-- (1/PowerN(x,-y));
-// integer powers are very fast
-61 # x_IsPositiveNumber ^ y_IsPositiveInteger <-- MathIntPower(x,y);
-61 # x_IsPositiveNumber ^ y_IsNegativeInteger <-- 1/MathIntPower(x,-y);
-65 # (x_IsPositiveNumber ^ y_IsNumber)_InNumericMode() <-- Exp(y*Ln(x));
-
-90 # (-_x)^m_IsEven <-- x^m;
-91 # (x_IsConstant ^ (m_IsOdd / p_IsOdd))_(IsNegativeNumber(Re(N(Eval(x))))) <--
- -((-x)^(m/p));
-92 # (x_IsNegativeNumber ^ y_IsNumber)_InNumericMode() <-- Exp(y*Ln(x));
-
-
-70 # (_x ^ m_IsRationalOrNumber) ^ n_IsRationalOrNumber <-- x^(n*m);
-
-80 # (x_IsNumber/y_IsNumber) ^ n_IsPositiveInteger <-- x^n/y^n;
-80 # (x_IsNumber/y_IsNumber) ^ n_IsNegativeInteger <-- y^(-n)/x^(-n);
-80 # x_IsNegativeNumber ^ n_IsEven <-- (-x)^n;
-80 # x_IsNegativeNumber ^ n_IsOdd <-- -((-x)^n);
-
-
-100 # ((_x)*(_x ^ _m)) <-- x^(m+1);
-100 # ((_x ^ _m)*(_x)) <-- x^(m+1);
-100 # ((_x ^ _n)*(_x ^ _m)) <-- x^(m+n);
-
-100 # ((x_IsNumber)^(n_IsInteger/(_m)))_(n>1) <-- MathIntPower(x,n)^(1/m);
-
-100 # Sqrt(_n)^(m_IsEven) <-- n^(m/2);
-
-
-200 # x_IsMatrix ^ n_IsPositiveInteger <-- x*(x^(n-1));
-204 # (xlist_IsList ^ nlist_IsList)_(Length(xlist)=Length(nlist)) <--
- Map("^",{xlist,nlist});
-205 # (xlist_IsList ^ n_IsConstant)_(Not(IsList(n))) <--
- Map({{xx},xx^n},{xlist});
-206 # (_x ^ n_IsList)_(Not(IsList(x))) <-- Map({{xx},x^xx},{n});
-249 # x_IsInfinity ^ 0 <-- Undefined;
-250 # Infinity ^ (_n) <-- Infinity;
-250 # Infinity ^ (_x_IsComplex) <-- Infinity;
-250 # ((-Infinity) ^ (n_IsNumber))_(IsEven(n)) <-- Infinity;
-250 # ((-Infinity) ^ (n_IsNumber))_(IsOdd(n)) <-- -Infinity;
-
-250 # (x_IsNumber ^ Infinity)_(x> -1 And x < 1) <-- 0;
-250 # (x_IsNumber ^ Infinity)_(x> 1) <-- Infinity;
-
-// these Magnitude(x)s should probably be changed to Abs(x)s
-
-250 # (x_IsComplex ^ Infinity)_(Magnitude(x) > 1) <-- Infinity;
-250 # (x_IsComplex ^ Infinity)_(Magnitude(x) < -1) <-- -Infinity;
-250 # (x_IsComplex ^ Infinity)_(Magnitude(x) > -1 And Magnitude(x) < 1) <-- 0;
-
-250 # (x_IsNumber ^ -Infinity)_(x> -1 And x < 1) <-- Infinity;
-250 # (x_IsNumber ^ -Infinity)_(x< -1) <-- 0;
-250 # (x_IsNumber ^ -Infinity)_(x> 1) <-- 0;
-
-255 # (x_IsComplex ^ Infinity)_(Abs(x) = 1) <-- Undefined;
-255 # (x_IsComplex ^ -Infinity)_(Abs(x) = 1) <-- Undefined;
-
-
-
-400 # _x ^ 0 <-- 1;
-
-%/mathpiper
-
-
-%mathpiper_docs,name="^",categories="Operators"
-*CMD ^ --- arithmetic power
-*STD
-*CALL
-
- x^y
-Precedence:
-*EVAL OpPrecedence("^")
-
-*PARMS
-
-{x} and {y} -- objects for which arithmetic operations are defined
-
-*DESC
-
-These are the basic arithmetic operations. They can work on integers,
-rational numbers, complex numbers, vectors, matrices and lists.
-
-These operators are implemented in the standard math library (as opposed
-to being built-in). This means that they can be extended by the user.
-
-*E.G.
-
- In> 2^3
- Out> 8;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/minus_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/minus_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/minus_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/minus_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,105 +0,0 @@
-%mathpiper,def="-"
-
-/* Subtraction arity 1 */
-
-//50 # -0 <-- 0;
-51 # -Undefined <-- Undefined;
-54 # - (- _x) <-- x;
-55 # (- (x_IsNumber)) <-- SubtractN(0,x);
-100 # _x - n_IsConstant*(_x) <-- (1-n)*x;
-100 # n_IsConstant*(_x) - _x <-- (n-1)*x;
-
-110 # - (_x - _y) <-- y-x;
-111 # - (x_IsNumber / _y) <-- (-x)/y;
-LocalSymbols(x)
-[
- 200 # - (x_IsList) <-- MapSingle("-",x);
-];
-
-/* Subtraction arity 2 */
-50 # x_IsNumber - y_IsNumber <-- SubtractN(x,y);
-50 # x_IsNumber - y_IsNumber <-- SubtractN(x,y);
-60 # Infinity - Infinity <-- Undefined;
-100 # 0 - _x <-- -x;
-100 # _x - 0 <-- x;
-100 # _x - _x <-- 0;
-
-110 # _x - (- _y) <-- x + y;
-110 # _x - (y_IsNegativeNumber) <-- x + (-y);
-111 # (_x + _y)- _x <-- y;
-111 # (_x + _y)- _y <-- x;
-112 # _x - (_x + _y) <-- - y;
-112 # _y - (_x + _y) <-- - x;
-113 # (- _x) - _y <-- -(x+y);
-113 # (x_IsNegativeNumber) - _y <-- -((-x)+y);
-113 # (x_IsNegativeNumber)/_y - _z <-- -((-x)/y+z);
-
-
-/* TODO move to this precedence everywhere? */
-LocalSymbols(x,y,xarg,yarg)
-[
- 10 # ((x_IsList) - (y_IsList))_(Length(x)=Length(y)) <--
- [
- Map({{xarg,yarg},xarg-yarg},{x,y});
- ];
-];
-
-240 # (x_IsList - y_IsNonObject)_Not(IsList(y)) <-- -(y-x);
-
-241 # (x_IsNonObject - y_IsList)_Not(IsList(x)) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(y),i++)
- [ DestructiveInsert(result,i,x - y[i]); ];
- result;
-];
-
-250 # z_IsInfinity - Complex(_x,_y) <-- Complex(-x+z,-y);
-250 # Complex(_x,_y) - z_IsInfinity <-- Complex(x-z,y);
-
-251 # z_IsInfinity - _x <-- z;
-251 # _x - z_IsInfinity <-- -z;
-
-250 # Undefined - _y <-- Undefined;
-250 # _x - Undefined <-- Undefined;
-// fractions
-210 # x_IsNumber - (y_IsNumber / z_IsNumber) <--(x*z-y)/z;
-210 # (y_IsNumber / z_IsNumber) - x_IsNumber <--(y-x*z)/z;
-210 # (x_IsNumber / v_IsNumber) - (y_IsNumber / z_IsNumber) <--(x*z-y*v)/(v*z);
-
-%/mathpiper
-
-
-%mathpiper_docs,name="-",categories="Operators"
-*CMD - --- arithmetic subtraction or negation
-*STD
-*CALL
-
- x-y
-Precedence: left-side:
-*EVAL OpPrecedence("-")
-, right-side:
-*EVAL OpRightPrecedence("-")
-
- -x
-
-*PARMS
-
-{x} and {y} -- objects for which subtraction is defined
-
-*DESC
-
-The subtraction operators can work on integers,
-rational numbers, complex numbers, vectors, matrices and lists.
-
-These operators are implemented in the standard math library (as opposed
-to being built-in). This means that they can be extended by the user.
-
-*E.G.
-
- In> 2-3
- Out> -1;
- In> - 3
- Out> -3;
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/plus_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/plus_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/plus_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/plus_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,101 +0,0 @@
-%mathpiper,def="+"
-
-/* Addition */
-
-100 # + _x <-- x;
-
-50 # x_IsNumber + y_IsNumber <-- AddN(x,y);
-
-100 # 0 + _x <-- x;
-100 # _x + 0 <-- x;
-100 # _x + _x <-- 2*x;
-100 # _x + n_IsConstant*(_x) <-- (n+1)*x;
-100 # n_IsConstant*(_x) + _x <-- (n+1)*x;
-101 # _x + - _y <-- x-y;
-101 # _x + (- _y)/(_z) <-- x-(y/z);
-101 # (- _y)/(_z) + _x <-- x-(y/z);
-101 # (- _x) + _y <-- y-x;
-102 # _x + y_IsNegativeNumber <-- x-(-y);
-102 # _x + y_IsNegativeNumber * _z <-- x-((-y)*z);
-102 # _x + (y_IsNegativeNumber)/(_z) <-- x-((-y)/z);
-102 # (y_IsNegativeNumber)/(_z) + _x <-- x-((-y)/z);
-102 # (x_IsNegativeNumber) + _y <-- y-(-x);
-// fractions
-150 # _n1 / _d + _n2 / _d <-- (n1+n2)/d;
-
-200 # (x_IsNumber + _y)_Not(IsNumber(y)) <-- y+x;
-200 # ((_y + x_IsNumber) + _z)_Not(IsNumber(y) Or IsNumber(z)) <-- (y+z)+x;
-200 # ((x_IsNumber + _y) + z_IsNumber)_Not(IsNumber(y)) <-- y+(x+z);
-200 # ((_x + y_IsNumber) + z_IsNumber)_Not(IsNumber(x)) <-- x+(y+z);
-// fractions
-210 # x_IsNumber + (y_IsNumber / z_IsNumber) <--(x*z+y)/z;
-210 # (y_IsNumber / z_IsNumber) + x_IsNumber <--(x*z+y)/z;
-210 # (x_IsNumber / v_IsNumber) + (y_IsNumber / z_IsNumber) <--(x*z+y*v)/(v*z);
-
-
-// 220 # + x_IsList <-- MapSingle("+",x); // this rule is never active
-
-220 # (xlist_IsList + ylist_IsList)_(Length(xlist)=Length(ylist)) <-- Map("+",{xlist,ylist});
-
-SumListSide(_x, y_IsList) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(y),i++)
- [ DestructiveInsert(result,i,x + y[i]); ];
- result;
-];
-
-240 # (x_IsList + _y)_Not(IsList(y)) <-- SumListSide(y,x);
-241 # (_x + y_IsList)_Not(IsList(x)) <-- SumListSide(x,y);
-
-250 # z_IsInfinity + Complex(_x,_y) <-- Complex(x+z,y);
-250 # Complex(_x,_y) + z_IsInfinity <-- Complex(x+z,y);
-
-251 # z_IsInfinity + _x <-- z;
-251 # _x + z_IsInfinity <-- z;
-
-
-250 # Undefined + _y <-- Undefined;
-250 # _x + Undefined <-- Undefined;
-
-%/mathpiper
-
-
-
-
-%mathpiper,scope="nobuild",subtype="test_suite"
-//This fold is used to test the + operator.
- Verify(3 + 2 , 5);
-%/mathpiper
-
-
-
-%mathpiper_docs,name="+",categories="Operators"
-*CMD + --- arithmetic addition
-*STD
-*CALL
-
- x+y
- +x
-Precedence:
-*EVAL OpPrecedence("+")
-
-*PARMS
-
-{x} and {y} -- objects for which arithmetic addition is defined
-
-
-*DESC
-
-The addition operators can work on integers,
-rational numbers, complex numbers, vectors, matrices and lists.
-
-These operators are implemented in the standard math library (as opposed
-to being built-in). This means that they can be extended by the user.
-
-*E.G.
-
- In> 2+3
- Out> 5;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/slash_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/slash_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdarith/slash_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdarith/slash_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,102 +0,0 @@
-%mathpiper,def="/"
-
-/* Division */
-
-50 # 0 / 0 <-- Undefined;
-
-52 # x_IsPositiveNumber / 0 <-- Infinity;
-52 # x_IsNegativeNumber / 0 <-- -Infinity;
-55 # (_x / y_IsNumber)_(IsZero(y)) <-- Undefined;
-55 # 0 / _x <-- 0;
-60 # (x_IsNumber / y_IsNumber)_(InNumericMode() /* Sorry, Serge Or
- Not(IsInteger(x) And IsInteger(y)) */ ) <--
- DivideN(x,y);
-
-// unnecessary rule (see #100 below). TODO: REMOVE
-//55 # x_IsNumber / y_IsNegativeNumber <-- (-x)/(-y);
-
-56 # (x_IsNonZeroInteger / y_IsNonZeroInteger)_(GcdN(x,y) > 1) <--
- [
- Local(gcd);
- Set(x,x);
- Set(y,y);
- Set(gcd,GcdN(x,y));
- DivN(x,gcd)/DivN(y,gcd);
- ];
-
-
-90 # x_IsInfinity / y_IsInfinity <-- Undefined;
-95 # x_IsInfinity / y_IsNumber <-- Sign(y)*x;
-95 # x_IsInfinity / y_IsComplex <-- Infinity;
-
-90 # Undefined / _y <-- Undefined;
-90 # _y / Undefined <-- Undefined;
-
-
-100 # _x / _x <-- 1;
-100 # _x / 1 <-- x;
-100 # (_x / y_IsNegativeNumber) <-- -x/(-y);
-100 # (_x / - _y) <-- -x/y;
-// fractions
-200 # (_x / _y)/ _z <-- x/(y*z);
-230 # _x / (_y / _z) <-- (x*z)/y;
-
-240 # (xlist_IsList / ylist_IsList)_(Length(xlist)=Length(ylist)) <--
- Map("/",{xlist,ylist});
-
-
-250 # (x_IsList / _y)_(Not(IsList(y))) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(x),i++)
- [ DestructiveInsert(result,i,x[i] / y); ];
- result;
-];
-
-250 # (_x / y_IsList)_(Not(IsList(x))) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(y),i++)
- [ DestructiveInsert(result,i,x/y[i]); ];
- result;
-];
-
-250 # _x / Infinity <-- 0;
-250 # _x / (-Infinity) <-- 0;
-
-
-400 # 0 / _x <-- 0;
-
-%/mathpiper
-
-
-%mathpiper_docs,name="/",categories="Operators"
-*CMD / --- arithmetic division
-*STD
-*CALL
-
- x/y
-Precedence:
-*EVAL OpPrecedence("/")
-
-*PARMS
-
-{x} and {y} -- objects for which arithmetic division is defined
-
-*DESC
-
-The division operator can work on integers,
-rational numbers, complex numbers, vectors, matrices and lists.
-
-This operator is implemented in the standard math library (as opposed
-to being built-in). This means that they can be extended by the user.
-
-*E.G.
-
- In> 6/2
- Out> 3;
-
-*SEE %_v1
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdopers/stdopers.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdopers/stdopers.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/initialization/stdopers/stdopers.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/initialization/stdopers/stdopers.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,121 +0,0 @@
-%mathpiper,def=""
-
-
-/* stdopers is loaded immediately after MathPiper is started. It contains
- * the definitions of the infix operators, so the parser can already
- * parse expressions containing these operators, even though the
- * function hasn't been defined yet.
- */
-
-Infix("=",90);
-Infix("And",1000);
-RightAssociative("And");
-Infix("Or", 1010);
-Prefix("Not", 100);
-Infix("<",90);
-Infix(">",90);
-Infix("<=",90);
-Infix(">=",90);
-Infix("!=",90);
-
-Infix(":=",10000);
-RightAssociative(":=");
-
-Infix("+",70);
-Infix("-",70);
-RightPrecedence("-",40);
-Infix("/",30);
-Infix("*",40);
-Infix("^",20);
-RightAssociative("^");
-Prefix("+",50);
-Prefix("-",50);
-RightPrecedence("-",40);
-Bodied("For",60000);
-Bodied("Until",60000);
-Postfix("++",5);
-Postfix("--",5);
-Bodied("ForEach",60000);
-Infix("<<",10);
-Infix(">>",10);
-Bodied("D",60000);
-Bodied("Deriv",60000);
-Infix("X",30);
-Infix(".",30);
-Infix("o",30);
-Postfix("!", 30);
-Postfix("!!", 30);
-Infix("***", 50);
-Bodied("Integrate",60000);
-
-Bodied("Limit",60000);
-
-Bodied("EchoTime", 60000);
-
-Bodied("Repeat", 60000);
-
-Infix("->",600);
-
-/* functional operators */
-Infix(":",70);
-RightAssociative(":");
-Infix("@",600);
-Infix("/@",600);
-Infix("..",600);
-
-Bodied("Taylor",60000);
-Bodied("Taylor1",60000);
-Bodied("Taylor2",60000);
-Bodied("Taylor3",60000);
-Bodied("InverseTaylor",60000);
-
-Infix("<--",10000);
-Infix("#",9900);
-
-Bodied("TSum",60000);
-Bodied("TExplicitSum",60000);
-Bodied("TD",5); /* Tell the MathPiper interpreter that TD is to be used as TD(i)f */
-
-/* Operator to be used for non-evaluating comparisons */
-Infix("==",90);
-Infix("!==",90);
-
-/* Operators needed for propositional logic theorem prover */
-Infix("=>",10000); /* implication, read as 'implies' */
-
-
-Bodied("if",5);
-Infix("else",60000);
-RightAssociative("else");
-/* Bitwise operations we REALLY need. Perhaps we should define them
- also as MathPiper operators?
- */
-Infix("&",50);
-Infix("|",50);
-Infix("%",50);
-
-/* local pattern replacement operators */
-Infix("/:",20000);
-Infix("/::",20000);
-Infix("<-",10000);
-
-/* Operators used for manual layout */
-Infix("<>", OpPrecedence("="));
-Infix("<=>", OpPrecedence("="));
-
-/* Operators for Solve: Where and AddTo */
-Infix("Where", 11000);
-Infix("AddTo", 2000);
-
-Bodied("Function",60000);
-Bodied("Macro",60000);
-
-Bodied(Assert, 60000);
-
-// Defining very simple functions, in scripts that can be converted to plugin.
-Bodied("Defun",0);
-
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/AntiDeriv.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/AntiDeriv.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/AntiDeriv.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/AntiDeriv.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,268 +0,0 @@
-%mathpiper,def="AntiDeriv",scope="private"
-
-//todo:tk:this file need to be broken down further.
-
-//tk:this code was moved here from Integrate.mrw because it was causing a
-// "rulebase with this arity already defined" error.
-//hso:but the RuleBase line causes hang when processing in fold
-//RuleBase("IntegrateMultiplicative",{var,from,a,b});
-
-////////////////////////////////////////////////
-//
-// Anti-derivative of a univariate polynomial
-//
-////////////////////////////////////////////////
-5 # AntiDeriv(_var, poly_CanBeUni(var) )
- <-- NormalForm(AntiDeriv(var,`MakeUni(@poly,@var)));
-5 # AntiDeriv(_var,UniVariate(_var,_first,_coefs)) <--
-[
- Local(result,i);
- result:=FlatCopy(coefs);
- For(i:=1,i<=Length(result),i++)
- [
- result[i]:= result[i]/(first+i);
- ];
- UniVariate(var,first+1,result);
-];
-
-
-////////////////////////////////////////////////
-//
-// Standard additive properties of integration.
-//
-////////////////////////////////////////////////
-10 # AntiDeriv(_var,_x + _y) <-- AntiDeriv(var,x) + AntiDeriv(var,y);
-10 # AntiDeriv(_var,_x - _y) <-- AntiDeriv(var,x) - AntiDeriv(var,y);
-10 # AntiDeriv(_var, - _y) <-- - AntiDeriv(var,y);
-
-10 # AntiDeriv(_var,_x/c_IsFreeOf(var) )_(HasExpr(x,var)) <-- AntiDeriv(var,x)/c;
-10 # AntiDeriv(_var,c_IsFreeOf(var)/_x )_(HasExpr(x,var) And c!= 1)
- <-- c*AntiDeriv(var,1/x);
-
-
-////////////////////////////////////////////////
-//
-// Multiplying a polynomial with another (integrable)
-// function, Integrate by parts.
-//
-////////////////////////////////////////////////
-1570 # IntegrateMultiplicative(_var,(exy_CanBeUni(var)) * _exx,_dummy1,_dummy2)
- <-- IntByParts(var,exy*exx,AntiDeriv(var,exx));
-1570 # IntegrateMultiplicative(_var,_exx * (exy_CanBeUni(var)),_dummy1,_dummy2)
- <-- IntByParts(var,exy*exx,AntiDeriv(var,exx));
-10 # IntByParts(_var,_exy * _exx,Integrate(_var)(_something)) <--
- `Hold(AntiDeriv(@var,((@exy)*(@exx))));
-20 # IntByParts(_var,_exy * _exx,_anti)_(Not IsFreeOf(anti,exx)) <--
- `Hold(AntiDeriv(@var,((@exy)*(@exx))));
-30 # IntByParts(_var,_exy * _exx,_anti) <--
- [
- Local(cf);
- cf:=anti*Deriv(var)exy;
-// Echo({exy*anti,exy*exx,cf});
- exy*anti - `(AntiDeriv(@var,@cf));
- ];
-
-////////////////////////////////////////////////
-//
-// Rational functions: f(x)/g(x) where f and g are
-// polynomials.
-//
-////////////////////////////////////////////////
-1570 # IntegrateMultiplicative(_var,(exy_CanBeUni(var)) / (exx_CanBeUni(var)),_dummy1,_dummy2) <--
- IntRat(var,exy/exx,MakeUni(exy,var),MakeUni(exx,var));
-
-10 # IntRat(_var,_exy / _exx,_exyu,_exxu)_
- (Degree(exyu) > Degree(exxu) Or Degree(Gcd(exyu,exxu)) > 0) <--
- [
- Local(gcd);
- gcd:=Gcd(exxu,exyu);
- exyu:=Div(exyu,gcd);
- exxu:=Div(exxu,gcd);
- AntiDeriv(var,NormalForm(Div(exyu,exxu))) +
- AntiDeriv(var,NormalForm(Mod(exyu,exxu))/NormalForm(exxu));
- ];
-
-11 # IntRat(_var,_exy / _exx,_exyu,_exxu)_
- (Degree(exxu,var) > 1 And LeadingCoef(exxu)=1 And
- IsNumericList(Coef(exxu,var,0 .. Degree(exxu)))) <--
-[
- Local(ee);
- ee:=Apart(exy/exx,var);
- `AntiDeriv(@var,@ee);
-];
-
-
-20 # IntRat(_var,_exy / _exx,_exyu,_exxu) <--
- `Hold(AntiDeriv(@var,((@exy)/(@exx))));
-
-
-30 # AntiDeriv(_var,Deriv(_var)(_expr)) <-- expr;
-
-////////////////////////////////////////////////
-//
-// No simple form, try something else
-//
-////////////////////////////////////////////////
-100 # AntiDeriv(_var,_exp) <--
-[
- IntegrateMultiplicative(var,exp,a,b);
-];
-
-
-////////////////////////////////////////////////
-//
-// Special anti-derivatives can be added here.
-//
-////////////////////////////////////////////////
-
-// integrating expressions containing if:
-10 # IntegrateMultiplicative(_var,if(_cond)(_body),_a,_b)
- <--
- [
- body := AntiDeriv(var,body);
- `Hold(if(@cond)(@body));
- ];
-// integrating expressions containing else
-10 # IntegrateMultiplicative(_var,(_left) else (_right),_a,_b)
- <--
- [
- left := AntiDeriv(var,left);
- right := AntiDeriv(var,right);
- `Hold( (@left) else (@right) );
- ];
-
-
-////////////////////////////////////////////////
-//
-// Could not find anti-derivative, return unsimplified
-//
-////////////////////////////////////////////////
-1600 # IntegrateMultiplicative(_var,_exp,_a,_b) <-- `Hold(Integrate(@var)(@exp));
-
-////////////////////////////////////////////////
-//
-// IntFunc declares the anti-derivative of a function
-// that has one argument.
-// Calling sequence: IntFunc(variable,from,to);
-// Example: IntFunc(x,Cos(_x),Sin(x));
-//
-////////////////////////////////////////////////
-LocalSymbols(intpred)
-[
- intpred := 50;
- IntFunc(_vr,_from,_to) <--
- [
- `((@intpred) # IntegrateMultiplicative(_var,@from,_dummy1,_dummy2)_MatchLinear(var,@vr) <-- (@to)/Matched'a());
- intpred++;
- ];
-];
-
-
-IntPureSquare(_vr,_from,_sign2,_sign0,_to) <--
-[
- `(50 # IntegrateMultiplicative(_var,@from,_dummy1,_dummy2)_MatchPureSquared(var,@sign2,@sign0,@vr) <-- (@to));
-];
-
-
-
-
-////////////////////////////////////////////////
-//
-// Declaration of the anti-derivatives of a few analytic functions
-//
-////////////////////////////////////////////////
-
-
-IntFunc(x,Sqrt(_x),(2*Sqrt(x)^(3))/3);
-IntFunc(x,1/_x^(_n),x^(1-n)/(1-n) );
-IntFunc(x,Sin(_x),-Cos(x));
-IntFunc(x,1/Sin(_x), Ln( 1/Sin(x) - Cos(x)/Sin(x) ) );
-IntFunc(x,Cos(_x),Sin(x));
-IntFunc(x,1/Cos(_x),Ln(1/Cos(x)+Tan(x)));
-IntFunc(x,Tan(_x),-Ln(Cos(x)));
-IntFunc(x,1/Tan(_x),Ln(Sin(x)) );
-IntFunc(x,Cos(_x)/Sin(_x),Ln(Sin(x)));
-IntFunc(x,Exp(_x),Exp(x));
-IntFunc(x,(C_IsFreeOf(var))^(_x),C^x/Ln(C));
-// we don't need Ln(Abs(x))
-IntFunc(x,num_IsFreeOf(var) / (_x),num*Ln(x));
-IntFunc(x,Ln(_x),x*Ln(x)-x);
-// where did these 1+1's come from?
-IntFunc(x,(_x)*Ln(_x),(1/(1+1))*x^(1+1)*Ln(x) - (1/(1+1)^2)*x^(1+1) );
-IntFunc(x,Ln(_x)*(_x),(1/(1+1))*x^(1+1)*Ln(x) - (1/(1+1)^2)*x^(1+1) );
-
-IntFunc(x,1/Sin(_x)^2,-Cos(x)/Sin(x) );
-IntFunc(x,1/Cos(_x)^2,Tan(x) );
-IntFunc(x,1/(Sin(_x)*Tan(_x)),-1/Sin(x));
-IntFunc(x,Tan(_x)/Cos(_x),1/Cos(x));
-IntFunc(x,1/Sinh(_x)^2,-1/Tanh(x));
-IntFunc(x,1/Cosh(_x)^2,Tanh(x));
-IntFunc(x,1/(Sinh(_x)*Tan(_x)),-1/Sinh(x));
-IntFunc(x,Tanh(_x)/Cosh(_x),-1/Cosh(x));
-
-IntFunc(x,1/Sqrt(m_IsFreeOf(x)-_x^2),ArcSin(x/Sqrt(m)) );
-
-IntFunc(x,Exp(n_IsNumber*_x)*Sin(m_IsNumber*_x),Exp(n*x)*(n*Sin(m*x)- m*Cos(m*x))/(m^2+n^2) );
-
-// n>0
-IntFunc(x,Ln(_x)*(_x)^n_IsNumber,(1/(n+1))*x^(n+1)*Ln(x) - (1/(n+1)^2)*x^(n+1) );
-
-// n>0
-IntFunc(x,Ln(A_IsNumber*_x)*(_x)^n_IsNumber,(1/(n+1))*x^(n+1)*Ln(A*x) - (1/(n+1)^2)*x^(n+1) );
-
-IntFunc(x,Sin(Ln(_x)),x*Sin(Ln(x))/2 - x*Cos(Ln(x))/2 );
-IntFunc(x,Cos(Ln(_x)),x*Sin(Ln(x))/2 - x*Cos(Ln(x))/2 );
-
-IntFunc(x,1/((_x)*Ln(_x)),Ln(Ln(x)));
-
-IntFunc(x,(_x)^(-1),Ln(x));
-
-IntFunc(x,(_x)^(n_IsFreeOf(x)),x^(n+1)/(n+1));
-IntFunc(x,Sinh(_x),Cosh(x));
-IntFunc(x,Sinh(_x)^2,Sinh(2*x)/4 - x/2);
-IntFunc(x,1/Sinh(_x),Ln(Tanh(x/2)));
-IntFunc(x,Cosh(_x),Sinh(x));
-IntFunc(x,Cosh(_x)^2,Sinh(2*x)/4 + x/2);
-IntFunc(x,1/Cosh(_x),ArcTan(Sinh(x)));
-IntFunc(x,Tanh(_x),Ln(Cosh(x)));
-IntFunc(x,Tanh(_x)/Cosh(_x),-1/Cosh(x));
-IntFunc(x,1/Cosh(_x)^2,Tanh(x));
-//IntFunc(x,1/Sech(_x)*Coth(_x),-1/Sinh(x));
-IntFunc(x,1/Tanh(_x),Ln(Sinh(x)));
-
-IntFunc(x,Abs(_x),Abs(x)*x/2); // not 2*a
-
-IntFunc(x,ArcTan(_x),x*ArcTan(x) - Ln(x^2 + 1)/2);
-//IntFunc(x,ArcSin(_x),(x*ArcSin(x)) + Sqrt(1-x^2) );
-IntFunc(x,ArcCos(_x),x*ArcCos(x) - Sqrt(1-x^2) );
-
-IntFunc(x,ArcTanh(_x),x*ArcTanh(x) + Ln(1-x^2)/2 );
-IntFunc(x,ArcSinh(_x),x*ArcSinh(x) - Sqrt(x^2 + 1) );
-IntFunc(x,ArcCosh(_x),x*ArcCosh(x) - Sqrt(x-1)*Sqrt(x+1) );
-
-
-// n^2 > x^2
-//IntFunc(x,num_IsFreeOf(var)/(-(_x)^2 + n_IsNumber),num*ArcTanh(x/Sqrt(n))/n);
-
-// x^2 > n^2
-//IntFunc(x,num_IsFreeOf(var)/((_x)^2 - n_IsNumber),num * -ArcCoth(x/Sqrt(n))/Sqrt(n));
-
-// n^2 > x^2
-//IntFunc(x,num_IsFreeOf(var)/Sqrt(n_IsNumber - (_x)^2),num*ArcSin(x/Sqrt(n)));
-
-// previous code is killing this....
-IntFunc(x,num_IsFreeOf(var)/(A_IsNumber + B_IsNumber*(_x))^2,-num/(A*b + B^2*x));
-
-// Code works now?
-IntFunc(x,num_IsFreeOf(var)/(n_IsNumber + m_IsNumber*Exp(p_IsNumber*(_x))),num*x/n - num*Ln(n + m*Exp(p*x))/(n*p));
-IntFunc(x,num_IsFreeOf(var)/(m_IsNumber*Exp(p_IsNumber*(_x)) + n_IsNumber),num*x/n - num*Ln(n + m*Exp(p*x))/(n*p));
-
-// note:hso: removed erroneous "a" in denominator of function below
-IntPureSquare(x,num_IsFreeOf(var)/(_x),1,1,(num/(Sqrt(Matched'b()/Matched'a())))*ArcTan(var/Sqrt(Matched'b()/Matched'a())));
-
-///// Integrating Special Functions
-IntFunc(x,Erf(_x), x*Erf(x)+ 1/(Exp(x^2)*Sqrt(Pi)) );
-
-UnFence("IntegrateMultiplicative",4);
-
-%/mathpiper
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/Integrate.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/Integrate.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/Integrate.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/Integrate.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,144 +0,0 @@
-%mathpiper,def="Integrate"
-
-//todo:tk:this file need to be broken down further.
-
-
-10# (Integrate(_var)(expr_IsList))
- <-- Map("Integrate",{FillList(var,Length(expr)),expr});
-20 # (Integrate(_var)(_expr)) <-- IntSub(var,expr,AntiDeriv(var,IntClean(var,expr)));
-
-
-10 # IntSub(_var,_expr,Integrate(_var)(_expr2)) <--
- `Hold(Integrate(@var)(@expr));
-20 # IntSub(_var,_expr,_result) <-- result; // + UniqueConstant();
-
-////////////////////////////////////////////////
-//
-// Integrate over a range
-//
-////////////////////////////////////////////////
-10# (Integrate(_var,_from,_to)(expr_IsList))
- <-- Map("Integrate",{FillList(var,Length(expr)),
- FillList(from,Length(expr)),
- FillList(to,Length(expr)),
- expr});
-
-20 # (Integrate(_var,_from,_to)(_expr))
- <-- defIntegrate(var,from,to,expr,a,b);
-
-////////////////////////////////////////////////
-//
-// separate rules can be added here for specific integrals
-// to defIntegrate
-//
-////////////////////////////////////////////////
-
-10 # defIntegrate(_var,_from,_to,_expr,_a,_b)_(from = -to And IsOddFunction(expr,var)) <-- 0;
-
-// We need to define this case (integrating from 0 to 0 over an even function)
-// explicitly, otherwise the integration ends up going in to infinite recursion.
-// Extended it a little bit more, since if you are integrating from A to A,
-// then the result is obviously zero. There are perhaps situations where
-// this does not work, where we need to simplify (to-from) first. A naive
-// implementation caused a test to fail.
-
-10 # defIntegrate(_var,_from,_from,_expr,_a,_b) <-- 0;
-
-12 # defIntegrate(_var,_from,_to,_expr,_a,_b)_(from = -to And IsEvenFunction(expr,var))
- <-- 2*defIntegrate(var,0,to,expr,a,b);
-
-100 # defIntegrate(_var,_from,_to,_expr,_a,_b)_(Type(AntiDeriv(var,IntClean(var,expr))) != "AntiDeriv")
- <-- IntegrateRange(var,expr,from,to,AntiDeriv(var,IntClean(var,expr)));
-
-101 # defIntegrate(_var,_from,_to,_expr,_a,_b)
- <-- `Hold(Integrate(@var,@from,@to)(@expr));
-// <-- IntegrateRange(var,expr,from,to,AntiDeriv(var,expr));
-
-
-////////////////////////////////////////////////
-//
-// No anti-derivative found, return unavaluated.
-//
-////////////////////////////////////////////////
-10 # IntegrateRange(_var,_expr,_from,_to,Integrate(_var)_expr2)
- <-- `Hold(Integrate(@var,@from,@to)@expr);
-
-////////////////////////////////////////////////
-//
-// Anti-derivative found, return result.
-//
-////////////////////////////////////////////////
-20 # IntegrateRange(_var,_expr,_from,_to,_antideriv)
- <-- `(@antideriv Where @var == @to) - `(@antideriv Where @var == @from);
-
-////////////////////////////////////////////////
-//
-// IntClean cleans up an expression before passing
-// it on to integration. This function normalizes
-// an expression in a way desirable for integration.
-// TrigSimpCombine, for instance, expands expressions
-// containing trigonometric functions so that they are
-// additive as opposed to multiplicative.
-//
-// If the expression doesn't contain the variable,
-// just return it as-is. This fixes:
-// In> Integrate(x) z^100
-//
-// If the expression can be considered to be a sum
-// of terms in var, then avoid premature simplification.
-////////////////////////////////////////////////
-10 # IntClean(_var,_expr) <--
-[
- if( IsFreeOf(var,expr) Or IsSumOfTerms(var,expr) )[
- expr;
- ] else if ( HasFunc(expr,Sin) Or HasFunc(expr,Cos) )[
- Simplify(TrigSimpCombine(expr));
- ] else [
- Simplify(expr);
- ];
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Integrate",categories="User Functions;Calculus Related (Symbolic)"
-*CMD Integrate --- integration
-
-*STD
-*CALL
- Integrate(var, x1, x2) expr
- Integrate(var) expr
-
-*PARMS
-
-{var} -- atom, variable to integrate over
-
-{x1} -- first point of definite integration
-
-{x2} -- second point of definite integration
-
-{expr} -- expression to integrate
-
-*DESC
-
-This function integrates the expression {expr} with respect to the
-variable {var}. The first calling format is used to perform
-definite integration: the integration is carried out from $var=x1$
-to $var=x2$. The second form is for indefinite integration.
-
-Some simple integration rules have currently been
-implemented. Polynomials, some quotients of polynomials,
-trigonometric functions and their inverses, hyperbolic functions
-and their inverses, {Exp}, and {Ln}, and products of these
-functions with polynomials can be integrated.
-
-*E.G.
-
- In> Integrate(x,a,b) Cos(x)
- Out> Sin(b)-Sin(a);
- In> Integrate(x) Cos(x)
- Out> Sin(x);
-
-*SEE D, UniqueConstant
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/MatchLinear.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/MatchLinear.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/MatchLinear.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/MatchLinear.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,114 +0,0 @@
-%mathpiper,def="MatchLinear;MatchPureSquared"
-
-/*
-todo:tk:MatchPureSquared() is in this file because it is grouped with MatchLinear in a
-LocalSymbols() block.
-*/
-
-/* Def file definitions
-MatchPureSquared
-*/
-
-/** MatchLinear(variable,expression)
- */
-LocalSymbols(a,b)[
-
-10 # MatchLinear(var_IsAtom,expr_CanBeUni(var)) <--
-[
- Set(expr,MakeUni(expr,var));
- MatchLinear(expr);
-];
-20 # MatchLinear(_var,_expr) <-- False;
-
-10 # MatchLinear(_expr)_(Degree(expr,var)<2) <--
-[
- Check(IsUniVar(expr),ToString()Echo({"Incorrect argument ",expr," passed to MatchLinear"}));
-
-//TODO if I enable these checks, then integration fails (only users of this function any way). Can this be removed? Where are these variables cleared any way?
-// Check(a = Hold(a), ToString()(Echo({"Found bound variable a which should have been unbound, in MatchLinear: ", a, "=", Eval(a)})));
-// Check(b = Hold(b), ToString()(Echo({"Found bound variable b which should have been unbound, in MatchLinear: ", b, "=", Eval(b)})));
-
- a := Coef(expr,1);
- b := Coef(expr,0);
- True;
-];
-20 # MatchLinear(_expr) <-- False;
-UnFence("MatchLinear",1);
-UnFence("MatchLinear",2);
-
-/** MatchPureSquared(variable,expression) - matches expressions
- * of the form a*x^2+b.
- */
-10 # MatchPureSquared(var_IsAtom,_sign2,_sign0,expr_CanBeUni(var)) <--
-[
- Set(expr,MakeUni(expr,var));
- MatchPureSquared(expr,sign2,sign0);
-];
-20 # MatchPureSquared(_var,_sign2,_sign0,_expr) <-- False;
-
-10 # MatchPureSquared(_expr,_sign2,_sign0)_(Degree(expr,var)=2 And
- Coef(expr,1) = 0 And
- IsNumber(Coef(expr,0)) And
- IsNumber(Coef(expr,2)) And
- Coef(expr,0)*sign0 > 0 And
- Coef(expr,2)*sign2 > 0
- ) <--
-[
- Check(IsUniVar(expr),ToString()Echo({"Incorrect argument ",expr," passed to MatchLinear"}));
-//TODO if I enable these checks, then integration fails (only users of this function any way). Can this be removed? Where are these variables cleared any way?
-// Check(a = Hold(a), "Found bound variable which should have been unbound, in MatchLinear");
-// Check(b = Hold(b), "Found bound variable which should have been unbound, in MatchLinear");
- a := Coef(expr,2);
- b := Coef(expr,0);
- True;
-];
-20 # MatchPureSquared(_expr,_sign2,_sign0) <-- False;
-UnFence("MatchPureSquared",3);
-UnFence("MatchPureSquared",4);
-
-Matched'a() := a;
-Matched'b() := b;
-
-
-
-]; // LocalSymbols a,b
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MatchLinear",categories="User Functions;Predicates"
-*CMD MatchLinear --- match an expression to a polynomial of degree one in a variable
-*STD
-*CALL
- MatchLinear(x,expr)
-
-*PARMS
-
-{x} -- variable to express the univariate polynomial in
-
-{expr} -- expression to match
-
-*DESC
-
-{MatchLinear} tries to match an expression to a linear (degree less than
-two) polynomial. The function returns {True} if it could match, and
-it stores the resulting coefficients in the variables "{a}" and "{b}"
-as a side effect. The function calling this predicate should declare
-local variables "{a}" and "{b}" for this purpose.
-{MatchLinear} tries to match to constant coefficients which don't
-depend on the variable passed in, trying to find a form "{a*x+b}"
-with "{a}" and "{b}" not depending on {x} if {x} is given as the variable.
-
-*E.G.
-
- In> MatchLinear(x,(R+1)*x+(T-1))
- Out> True;
- In> {a,b};
- Out> {R+1,T-1};
- In> MatchLinear(x,Sin(x)*x+(T-1))
- Out> False;
-
-*SEE Integrate
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/integrate/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/integrate/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,11 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef( "Integrate", "calculus1","defint", // Same argument reordering as Sum.
- { $, _2 .. _3, OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) },
- { $, _{2,2,1}, _{1,1}, _{1,2}, _{2,3} }
- );
-OMDef( "AntiDeriv", mathpiper,"AntiDeriv" );
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Assert.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Assert.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Assert.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Assert.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,99 +0,0 @@
-%mathpiper,def="Assert"
-
-/// post an error if assertion fails
-(Assert(_error'class, _error'object) _predicate) <--
-[
- CheckErrorTableau();
- If(Equals(predicate, True), // if it does not evaluate to True, it's an error
- True,
- [ // error occurred, need to post error'object
- DestructiveAppend(GetErrorTableau(), {error'class, error'object});
- False;
- ]
- );
-];
-
-/// interface
-(Assert(_error'class) _predicate) <-- Assert(error'class, True) predicate;
-
-/// interface
-(Assert() _predicate) <-- Assert("generic", True) predicate;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Assert",categories="Programmer Functions;Error Reporting"
-*CMD Assert --- signal "soft" custom error
-*STD
-*CALL
- Assert("str", expr) pred
- Assert("str") pred
- Assert() pred
-Precedence:
-*EVAL OpPrecedence("Assert")
-
-*PARMS
-
-{pred} -- predicate to check
-
-{"str"} -- string to classify the error
-
-{expr} -- expression, error object
-
-*DESC
-
-{Assert} is a global error reporting mechanism. It can be used to check for
-errors and report them. An error is considered to occur when the predicate
-{pred} evaluates to anything except {True}. In this case, the function returns
-{False} and an error object is created and posted to the global error tableau.
-Otherwise the function returns {True}.
-
-Unlike the "hard" error function {Check}, the function {Assert} does not stop
-the execution of the program.
-
-The error object consists of the string {"str"} and an arbitrary
-expression {expr}. The string should be used to classify the kind of error that
-has occurred, for example "domain" or "format". The error object can be any expression that might be useful for handling the error later;
-for example, a list of erroneous values and explanations.
-The association list of error objects is currently obtainable through
-the function {GetErrorTableau()}.
-
-If the parameter {expr} is missing, {Assert} substitutes {True}. If both optional parameters {"str"} and {expr} are missing, {Assert} creates an error of class {"generic"}.
-
-Errors can be handled by a
-custom error handler in the portion of the code that is able to handle a certain class of
-errors. The functions {IsError}, {GetError} and {ClearError} can be used.
-
-Normally, all errors posted to the error tableau during evaluation of an expression should
-be eventually printed to the screen. This is the behavior of prettyprinters
-{DefaultPrint}, {Print}, {PrettyForm} and {TeXForm} (but not of the
-inline prettyprinter, which is enabled by default); they call
-{DumpErrors} after evaluating the expression.
-
-*E.G.
-
- In> Assert("bad value", "must be zero") 1=0
- Out> False;
- In> Assert("bad value", "must be one") 1=1
- Out> True;
- In> IsError()
- Out> True;
- In> IsError("bad value")
- Out> True;
- In> IsError("bad file")
- Out> False;
- In> GetError("bad value");
- Out> "must be zero";
- In> DumpErrors()
- Error: bad value: must be zero
- Out> True;
-No more errors left:
- In> IsError()
- Out> False;
- In> DumpErrors()
- Out> True;
-
-*SEE IsError, DumpErrors, Check, GetError, ClearError, ClearErrors, GetErrorTableau
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/DefaultPrint.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/DefaultPrint.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/DefaultPrint.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/DefaultPrint.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-%mathpiper,def="DefaultPrint"
-
-/// The new default pretty-printer: DefaultPrint
-Function("DefaultPrint", {x})
-[
- DumpErrors();
- WriteString("Out> ");
- Write(x);
- WriteString(";
-");
-];
-HoldArg("DefaultPrint", x);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/DumpErrors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/DumpErrors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/DumpErrors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/DumpErrors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="DumpErrors"
-
-/// print all errors and clear the tableau
-DumpErrors() <--
-[
- Local(error'object, error'word);
- CheckErrorTableau();
- ForEach(error'object, GetErrorTableau())
- [ // error'object might be e.g. {"critical", {"bad bad", -1000}}
- If(
- IsList(error'object),
- [
- If( // special case: error class "warning"
- Length(error'object) > 0 And error'object[1] = "warning",
- [
- error'word := "Warning";
- error'object[1] := ""; // don't print the word "warning" again
- ],
- error'word := "Error: " // important hack: insert ": " here but not after "Warning"
- );
-
- If( // special case: {"error'class", True}
- Length(error'object)=2 And error'object[2]=True,
- Echo(error'word, error'object[1]),
- [
- Echo(error'word, error'object[1], ": ",
- PrintList(Rest(error'object)));
- ]
- );
- ],
- // error'object is not a list: just print it
- Echo("Error: ", error'object)
- );
- ];
- ClearErrors();
-];
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="DumpErrors",categories="Programmer Functions;Error Reporting"
-*CMD DumpErrors --- simple error handlers
-*STD
-*CALL
- DumpErrors()
-
-*DESC
-
-{DumpErrors} is a simple error handler for the global error reporting mechanism. It prints all errors posted using {Assert} and clears the error tableau.
-
-*SEE Assert, IsError, ClearErrors
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Echo.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Echo.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Echo.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Echo.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,82 +0,0 @@
-%mathpiper,def="Echo"
-
-10 # EchoInternal(string_IsString) <--
-[
- WriteString(string);
-];
-
-20 # EchoInternal(_item) <--
-[
- Write(item);Space();
-];
-
-RuleBaseListed("Echo",{args});
-10 # Echo(list_IsList)<--
-[
- ForEach(item,list) EchoInternal(item);
- NewLine();
-];
-20 # Echo(_item)<--
-[
- EchoInternal(item);
- NewLine();
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Echo",categories="User Functions;Input/Output"
-*CMD Echo --- high-level printing routine
-*STD
-*CALL
- Echo(item)
- Echo(list)
- Echo(item,item,item,...)
-
-*PARMS
-
-{item} -- the item to be printed
-
-{list} -- a list of items to be printed
-
-*DESC
-
-If passed a single item, {Echo} will evaluate it and print it to the
-current output, followed by a newline. If {item} is a string, it is
-printed without quotation marks.
-
-If there is one argument, and it is a list, {Echo} will print all the
-entries in the list subsequently to the current output, followed by a
-newline. Any strings in the list are printed without quotation
-marks. All other entries are followed by a space.
-
-{Echo} can be called with a variable number of arguments, they will all
-be printed, followed by a newline.
-
-{Echo} always returns {True}.
-
-*E.G. notest
-
- In> Echo(5+3);
- 8
- Out> True;
- In> Echo({"The square of two is ", 2*2});
- The square of two is 4
- Out> True;
- In> Echo("The square of two is ", 2*2);
- The square of two is 4
- Out> True;
-
-Note that one must use the second calling format if one wishes to
-print a list:
-
- In> Echo({a,b,c});
- a b c
- Out> True;
- In> Echo({{a,b,c}});
- {a,b,c}
- Out> True;
-
-*SEE PrettyForm, Write, WriteString, RuleBaseListed
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/GetErrorTableau.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/GetErrorTableau.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/GetErrorTableau.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/GetErrorTableau.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,112 +0,0 @@
-%mathpiper,def="GetErrorTableau;ClearErrors;GetError"
-
-/* def file definitions
-ClearErrors
-GetError
-*/
-
-//////////////////////////////////////////////////
-/// ErrorTableau, Assert, IsError --- global error reporting
-//////////////////////////////////////////////////
-
-LocalSymbols(ErrorTableau) [
-
- /// global error tableau. Its entries do not have to be lists.
- Set(ErrorTableau, {});
-
- GetErrorTableau() := ErrorTableau;
-
- ClearErrors() <-- Set(ErrorTableau, {});
-
- /// aux function to check for corrupt tableau
- CheckErrorTableau() <--
- If(
- Not IsList(ErrorTableau),
- Set(ErrorTableau, {{"general", "corrupted ErrorTableau"}})
- );
-
-]; // LocalSymbols(ErrorTableau)
-
-
-/// obtain error object
-GetError(error'class_IsString) <--
-[
- Local(error);
- error := GetErrorTableau()[error'class];
- If(
- error != Empty,
- error,
- False
- );
-];
-
-
-/// delete error
-ClearError(error'class_IsString) <-- AssocDelete(GetErrorTableau(), error'class);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="ClearErrors",categories="Programmer Functions;Error Reporting"
-*CMD ClearErrors --- simple error handlers
-*STD
-*CALL
- ClearErrors()
-
-*DESC
-
-{ClearErrors} is a trivial error handler that does nothing except it clears the tableau.
-
-*SEE Assert, IsError, DumpErrors
-
-%/mathpiper_docs
-
-
-
-
-%mathpiper_docs,name="GetError;ClearError;GetErrorTableau",categories="Programmer Functions;Error Reporting"
-*CMD GetError --- custom errors handlers
-*CMD ClearError --- custom errors handlers
-*CMD GetErrorTableau --- custom errors handlers
-*STD
-*CALL
- GetError("str")
- ClearError("str")
- GetErrorTableau()
-
-*PARMS
-
-{"str"} -- string to classify the error
-
-*DESC
-
-These functions can be used to create a custom error handler.
-
-{GetError} returns the error object if a custom error of class {"str"} has been
-reported using {Assert}, or {False} if no errors of this class have been
-reported.
-
-{ClearError("str")} deletes the same error object that is returned by
-{GetError("str")}. It deletes at most one error object. It returns {True} if an
-object was found and deleted, and {False} otherwise.
-
-{GetErrorTableau()} returns the entire association list of currently reported errors.
-
-*E.G.
-
- In> x:=1
- Out> 1;
- In> Assert("bad value", {x,"must be zero"}) x=0
- Out> False;
- In> GetError("bad value")
- Out> {1, "must be zero"};
- In> ClearError("bad value");
- Out> True;
- In> IsError()
- Out> False;
-
-*SEE IsError, Assert, Check, ClearErrors
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/IsError.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/IsError.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/IsError.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/IsError.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="IsError"
-
-/// check for errors
-IsError() <--
-[
- CheckErrorTableau();
- Length(GetErrorTableau())>0;
-];
-
-/// check for errors of a given kind
-IsError(error'class_IsString) <--
-[
- CheckErrorTableau();
- GetErrorTableau()[error'class] != Empty;
-];
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="IsError",categories="Programmer Functions;Error Reporting;Predicates"
-*CMD IsError --- check for custom error
-*STD
-*CALL
- IsError()
- IsError("str")
-
-*PARMS
-
-{"str"} -- string to classify the error
-
-*DESC
-
-{IsError()} returns {True} if any custom errors have been reported using {Assert}.
-The second form takes a parameter {"str"} that designates the class of the
-error we are interested in. It returns {True} if any errors of the given class
-{"str"} have been reported.
-
-*SEE GetError, ClearError, Assert, Check
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/PrettyForm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/PrettyForm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/PrettyForm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/PrettyForm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,508 +0,0 @@
-%mathpiper,def="PrettyForm;EvalFormula"
-
-/* def file definitions
-EvalFormula
-*/
-
-
-/*
-TODO:
-- Func(a=b) prematurely evaluates a=b
-- clean up the code!
- - document the code!!!
-- prefix/postfix currently not used!!!
-- some rules for rendering the formula are slooooww....
-
-- bin, derivative, sqrt, integral, summation, limits,
- ___
- / a |
- \ / -
- \/ b
-
- /
- |
- |
- |
- /
-
- d
- --- f( x )
- d x
-
- 2
- d
- ---- f( x )
- 2
- d x
-
- Infinity
- ___
- \
- \ n
- / x
- /__
- n = 0
- Sin(x)
- lim ------
- x -> Infinity x
-
-
-
-*/
-
-/*
-NLog(str):=
-[
- WriteString(str);
- NewLine();
-];
-*/
-
-CharList(length,item):=
-[
- Local(line,i);
- line:="";
- For(Set(i,0),LessThan(i,length),Set(i,AddN(i,1)))
- Set(line, line:item);
- line;
-];
-
-CharField(width,height) := ArrayCreate(height,CharList(width," "));
-
-WriteCharField(charfield):=
-[
- Local(i,len);
- len:=Length(charfield);
- For(Set(i,1),i<=len,Set(i,AddN(i,1)))
- [
- WriteString(charfield[i]);
- NewLine();
- ];
- True;
-];
-
-ColumnFilled(charfield,column):=
-[
- Local(i,result,len);
- result:=False;
- len:=Length(charfield);
- For(Set(i, 1),(result = False) And (i<=len),Set(i,AddN(i,1)))
- [
- If(StringMidGet(column,1,charfield[i]) != " ",result:=True);
- ];
- result;
-];
-WriteCharField(charfield,width):=
-[
- Local(pos,length,len);
- Set(length, Length(charfield[1]));
- Set(pos, 1);
- While(pos<=length)
- [
- Local(i,thiswidth);
- Set(thiswidth, width);
- If(thiswidth>(length-pos)+1,
- [
- Set(thiswidth, AddN(SubtractN(length,pos),1));
- ],
- [
- While (thiswidth>1 And ColumnFilled(charfield,pos+thiswidth-1))
- [
- Set(thiswidth,SubtractN(thiswidth,1));
- ];
- If(thiswidth = 1, Set(thiswidth, width));
- ]
- );
- len:=Length(charfield);
- For(Set(i, 1),i<=len,Set(i,AddN(i,1)))
- [
- WriteString(StringMidGet(pos,thiswidth,charfield[i]));
- NewLine();
- ];
- Set(pos, AddN(pos, thiswidth));
- NewLine();
- ];
- True;
-];
-
-
-
-PutString(charfield,x,y,string):=
-[
- cf[y] := StringMidSet(x,string,cf[y]);
- True;
-];
-
-MakeOper(x,y,width,height,oper,args,base):=
-[
- Local(result);
- Set(result,ArrayCreate(7,0));
- ArraySet(result,1,x);
- ArraySet(result,2,y);
- ArraySet(result,3,width);
- ArraySet(result,4,height);
- ArraySet(result,5,oper);
- ArraySet(result,6,args);
- ArraySet(result,7,base);
- result;
-];
-
-
-MoveOper(f,x,y):=
-[
- f[1]:=AddN(f[1], x); /* move x */
- f[2]:=AddN(f[2], y); /* move y */
- f[7]:=AddN(f[7], y); /* move base */
-];
-
-AlignBase(i1,i2):=
-[
- Local(base);
- Set(base, Max(i1[7],i2[7]));
- MoveOper(i1,0,SubtractN(base,(i1[7])));
- MoveOper(i2,0,SubtractN(base,(i2[7])));
-];
-
-10 # BuildArgs({}) <-- Formula(Atom(" "));
-20 # BuildArgs({_head}) <-- head;
-30 # BuildArgs(_any) <--
- [
- Local(item1,item2,comma,base,newitem);
- Set(item1, any[1]);
- Set(item2, any[2]);
- Set(comma, Formula(Atom(",")));
- Set(base, Max(item1[7],item2[7]));
- MoveOper(item1,0,SubtractN(base,(item1[7])));
- MoveOper(comma,AddN(item1[3],1),base);
-
- MoveOper(item2,comma[1]+comma[3]+1,SubtractN(base,(item2[7])));
- Set(newitem, MakeOper(0,0,AddN(item2[1],item2[3]),Max(item1[4],item2[4]),"Func",{item1,comma,item2},base));
- BuildArgs(newitem:Rest(Rest(any)));
- ];
-
-
-
-FormulaBracket(f):=
-[
- Local(left,right);
- Set(left, Formula(Atom("(")));
- Set(right, Formula(Atom(")")));
- left[4]:=f[4];
- right[4]:=f[4];
- MoveOper(left,f[1],f[2]);
- MoveOper(f,2,0);
- MoveOper(right,f[1]+f[3]+1,f[2]);
- MakeOper(0,0,right[1]+right[3],f[4],"Func",{left,f,right},f[7]);
-];
-
-
-/* RuleBase("Formula",{f}); */
-
-1 # Formula(f_IsAtom) <--
- MakeOper(0,0,Length(String(f)),1,"Atom",String(f),0);
-
-2 # Formula(_xx ^ _yy) <--
-[
- Local(l,r);
- Set(l, BracketOn(Formula(xx),xx,OpLeftPrecedence("^")));
- Set(r, BracketOn(Formula(yy),yy,OpRightPrecedence("^")));
- MoveOper(l,0,r[4]);
- MoveOper(r,l[3],0);
- MakeOper(0,0,AddN(l[3],r[3]),AddN(l[4],r[4]),"Func",{l,r},l[2]+l[4]-1);
-];
-
-
-
-10 # FormulaArrayItem(xx_IsList) <--
-[
- Local(sub,height);
- sub := {};
- height := 0;
- ForEach(item,xx)
- [
- Local(made);
- made := FormulaBracket(Formula(item));
- If(made[4] > height,Set(height,made[4]));
- DestructiveAppend(sub,made);
- ];
- MakeOper(0,0,0,height,"List",sub,height>>1);
-];
-
-
-20 # FormulaArrayItem(_item) <-- Formula(item);
-
-2 # Formula(xx_IsList) <--
-[
- Local(sub,width,height);
- sub:={};
- width := 0;
- height := 1;
-
- ForEach(item,xx)
- [
- Local(made);
- made := FormulaArrayItem(item);
-
- If(made[3] > width,Set(width,made[3]));
- MoveOper(made,0,height);
- Set(height,AddN(height,AddN(made[4],1)));
- DestructiveAppend(sub,made);
- ];
-
- Local(thislength,maxlength);
- maxlength:=0;
- ForEach(item,xx)
- [
- thislength:=0;
- if(IsList(item)) [thislength:=Length(item);];
- if (maxlength0,
- [
- Local(i,j);
- width:=0;
- For(j:=1,j<=maxlength,j++)
- [
- Local(w);
- w := 0;
- For(i:=1,i<=Length(sub),i++)
- [
- if (IsList(xx[i]) And j<=Length(xx[i]))
- If(sub[i][6][j][3] > w,w := sub[i][6][j][3]);
- ];
-
- For(i:=1,i<=Length(sub),i++)
- [
- if (IsList(xx[i]) And j<=Length(xx[i]))
- MoveOper(sub[i][6][j],width,0);
- ];
- width := width+w+1;
- ];
- For(i:=1,i<=Length(sub),i++)
- [
- sub[i][3] := width;
- ];
- ]
- );
-
- sub := MakeOper(0,0,width,height,"List",sub,height>>1);
- FormulaBracket(sub);
-];
-
-2 # Formula(_xx / _yy) <--
-[
- Local(l,r,dash,width);
-/*
- Set(l, BracketOn(Formula(xx),xx,OpLeftPrecedence("/")));
- Set(r, BracketOn(Formula(yy),yy,OpRightPrecedence("/")));
-*/
- Set(l, Formula(xx));
- Set(r, Formula(yy));
- Set(width, Max(l[3],r[3]));
- Set(dash, Formula(Atom(CharList(width,"-"))));
- MoveOper(dash,0,l[4]);
- MoveOper(l,(SubtractN(width,l[3])>>1),0);
- MoveOper(r,(SubtractN(width,r[3])>>1),AddN(dash[2], dash[4]));
- MakeOper(0,0,width,AddN(r[2], r[4]),"Func",{l,r,dash},dash[2]);
-];
-
-RuleBase("BracketOn",{op,f,prec});
-Rule("BracketOn",3,1,IsFunction(f) And NrArgs(f) = 2
- And IsInfix(Type(f)) And OpPrecedence(Type(f)) > prec)
-[
- FormulaBracket(op);
-];
-Rule("BracketOn",3,2,True)
-[
- op;
-];
-
-10 # Formula(f_IsFunction)_(NrArgs(f) = 2 And IsInfix(Type(f))) <--
-[
- Local(l,r,oper,width,height,base);
- Set(l, Formula(f[1]));
- Set(r, Formula(f[2]));
-
- Set(l, BracketOn(l,f[1],OpLeftPrecedence(Type(f))));
- Set(r, BracketOn(r,f[2],OpRightPrecedence(Type(f))));
-
- Set(oper, Formula(f[0]));
- Set(base, Max(l[7],r[7]));
- MoveOper(oper,AddN(l[3],1),SubtractN(base,(oper[7])));
- MoveOper(r,oper[1] + oper[3]+1,SubtractN(base,(r[7])));
- MoveOper(l,0,SubtractN(base,(l[7])));
- Set(height, Max(AddN(l[2], l[4]),AddN(r[2], r[4])));
-
- MakeOper(0,0,AddN(r[1], r[3]),height,"Func",{l,r,oper},base);
-];
-
-11 # Formula(f_IsFunction) <--
-[
- Local(head,args,all);
- Set(head, Formula(f[0]));
- Set(all, Rest(Listify(f)));
-
- Set(args, FormulaBracket(BuildArgs(MapSingle("Formula",Apply("Hold",{all})))));
- AlignBase(head,args);
- MoveOper(args,head[3],0);
-
- MakeOper(0,0,args[1]+args[3],Max(head[4],args[4]),"Func",{head,args},head[7]);
-];
-
-
-
-RuleBase("RenderFormula",{cf,f,x,y});
-
-/*
-/ / /
-\ | |
- \ |
- \
-*/
-
-Rule("RenderFormula",4,1,f[5] = "Atom" And f[6] = "(" And f[4] > 1)
-[
- Local(height,i);
- Set(x, AddN(x,f[1]));
- Set(y, AddN(y,f[2]));
- Set(height, SubtractN(f[4],1));
-
- cf[y] := StringMidSet(x, "/", cf[y]);
- cf[AddN(y,height)] := StringMidSet(x, "\\", cf[AddN(y,height)]);
- For (Set(i,1),LessThan(i,height),Set(i,AddN(i,1)))
- cf[AddN(y,i)] := StringMidSet(x, "|", cf[AddN(y,i)]);
-];
-
-Rule("RenderFormula",4,1,f[5] = "Atom" And f[6] = ")" And f[4] > 1)
-[
- Local(height,i);
- Set(x, AddN(x,f[1]));
- Set(y, AddN(y,f[2]));
- Set(height, SubtractN(f[4],1));
- cf[y] := StringMidSet(x, "\\", cf[y]);
- cf[y+height] := StringMidSet(x, "/", cf[y+height]);
- For (Set(i,1),LessThan(i,height),Set(i,AddN(i,1)))
- cf[AddN(y,i)] := StringMidSet(x, "|", cf[AddN(y,i)]);
-];
-
-Rule("RenderFormula",4,5,f[5] = "Atom")
-[
- cf[AddN(y, f[2]) ]:=
- StringMidSet(AddN(x,f[1]),f[6],cf[AddN(y, f[2]) ]);
-];
-
-Rule("RenderFormula",4,6,True)
-[
- ForEach(item,f[6])
- [
- RenderFormula(cf,item,AddN(x, f[1]),AddN(y, f[2]));
- ];
-];
-
-LocalSymbols(formulaMaxWidth) [
- SetFormulaMaxWidth(width):=
- [
- formulaMaxWidth := width;
- ];
- FormulaMaxWidth() := formulaMaxWidth;
- SetFormulaMaxWidth(60);
-]; // LocalSymbols(formulaMaxWidth)
-
-Function("PrettyForm",{ff})
-[
- Local(cf,f);
-
- f:=Formula(ff);
-
- cf:=CharField(f[3],f[4]);
- RenderFormula(cf,f,1,1);
-
- NewLine();
- WriteCharField(cf,FormulaMaxWidth());
-
- DumpErrors();
- True;
-];
-/*
-HoldArg("PrettyForm",ff);
-*/
-
-EvalFormula(f):=
-[
- Local(result);
- result:= UnList({Atom("="),f,Eval(f)});
- PrettyForm(result);
- True;
-];
-HoldArg("EvalFormula",f);
-
-/*
-{x,y,width,height,oper,args,base}
-*/
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PrettyForm",categories="User Functions;Input/Output"
-*CMD PrettyForm --- print an expression nicely with ASCII art
-*STD
-*CALL
- PrettyForm(expr)
-
-*PARMS
-
-{expr} -- an expression
-
-*DESC
-
-{PrettyForm} renders an expression in a nicer way, using ascii art.
-This is generally useful when the result of a calculation is more
-complex than a simple number.
-
-*E.G.
-
- In> Taylor(x,0,9)Sin(x)
- Out> x-x^3/6+x^5/120-x^7/5040+x^9/362880;
- In> PrettyForm(%)
-
- 3 5 7 9
- x x x x
- x - -- + --- - ---- + ------
- 6 120 5040 362880
-
- Out> True;
-
-*SEE EvalFormula, PrettyPrinter'Set
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="EvalFormula",categories="User Functions;Input/Output"
-*CMD EvalFormula --- print an evaluation nicely with ASCII art
-*STD
-*CALL
- EvalFormula(expr)
-
-*PARMS
-
-{expr} -- an expression
-
-*DESC
-
-Show an evaluation in a nice way, using {PrettyPrinter'Set}
-to show 'input = output'.
-
-*E.G.
-
- In> EvalFormula(Taylor(x,0,7)Sin(x))
-
- 3 5
- x x
- Taylor( x , 0 , 5 , Sin( x ) ) = x - -- + ---
- 6 120
-
-
-*SEE PrettyForm
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Print.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Print.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Print.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Print.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,120 +0,0 @@
-%mathpiper,def="Print"
-
-
-/* A reference print implementation. Expand at own leisure.
- *
- * This file implements Print, a scripted expression printer.
- */
-
-
-/* 60000 is the maximum precedence allowed for operators */
-10 # Print(_x) <--
-[
- Print(x,60000);
- NewLine();
- DumpErrors();
-];
-
-/* Print an argument within an environment of precedence n */
-10 # Print(x_IsAtom,_n) <-- Write(x);
-10 # Print(_x,_n)_(IsInfix(Type(x))And NrArgs(x) = 2) <--
-[
- Local(bracket);
- bracket:= (OpPrecedence(Type(x)) > n);
- If(bracket,WriteString("("));
- Print(x[1],OpLeftPrecedence(Type(x)));
- Write(x[0]);
- Print(x[2],OpRightPrecedence(Type(x)));
- If(bracket,WriteString(")"));
-];
-
-10 # Print(_x,_n)_(IsPrefix(Type(x)) And NrArgs(x) = 1) <--
-[
- Local(bracket);
- bracket:= (OpPrecedence(Type(x)) > n);
- Write(x[0]);
- If(bracket,WriteString("("));
- Print(x[1],OpRightPrecedence(Type(x)));
- If(bracket,WriteString(")"));
-];
-
-10 # Print(_x,_n)_(IsPostfix(Type(x))And NrArgs(x) = 1) <--
-[
- Local(bracket);
- bracket:= (OpPrecedence(Type(x)) > n);
- If(bracket,WriteString("("));
- Print(x[1],OpLeftPrecedence(Type(x)));
- Write(x[0]);
- If(bracket,WriteString(")"));
-];
-
-20 # Print(_x,_n)_(Type(x) = "List") <--
-[
- WriteString("{");
- PrintArg(x);
- WriteString("}");
-];
-
-20 # Print(_x,_n)_(Type(x) = "Prog") <--
-[
- WriteString("[");
- PrintArgProg(Rest(Listify(x)));
- WriteString("]");
-];
-20 # Print(_x,_n)_(Type(x) = "Nth") <--
-[
- Print(x[1],0);
- WriteString("[");
- Print(x[2],60000);
- WriteString("]");
-];
-
-100 # Print(x_IsFunction,_n) <--
- [
- Write(x[0]);
- WriteString("(");
- PrintArg(Rest(Listify(x)));
- WriteString(")");
- ];
-
-
-/* Print the arguments of an ordinary function */
-10 # PrintArg({}) <-- True;
-
-20 # PrintArg(_list) <--
-[
- Print(First(list),60000);
- PrintArgComma(Rest(list));
-];
-10 # PrintArgComma({}) <-- True;
-20 # PrintArgComma(_list) <--
-[
- WriteString(",");
- Print(First(list),60000);
- PrintArgComma(Rest(list));
-];
-
-
-18 # Print(Complex(0,1),_n) <-- [WriteString("I");];
-19 # Print(Complex(0,_y),_n) <-- [WriteString("I*");Print(y,4);];
-19 # Print(Complex(_x,1),_n) <-- [Print(x,7);WriteString("+I");];
-20 # Print(Complex(_x,_y),_n) <-- [Print(x,7);WriteString("+I*");Print(y,4);];
-
-
-/* Tail-recursive printing the body of a compound statement */
-10 # PrintArgProg({}) <-- True;
-20 # PrintArgProg(_list) <--
-[
- Print(First(list),60000);
- WriteString(";");
- PrintArgProg(Rest(list));
-];
-
-
-
-
-
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Show.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Show.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Show.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Show.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-%mathpiper,def="Show"
-Macro("Show",{id}) [SysOut("<< ",@id," >>");];
-Macro("Show",{id,x}) [SysOut("<< ",@id," >> ",Hold(@x),": ",Eval(@x));];
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-%mathpiper_docs,name="Show",categories="Programmer Functions;Testing"
-
-*CMD Show --- debug routine using SysOut to print ID and (optional) variable(s)
-
-*STD
-*CALL
- Show(ID)
- Show(ID,list)
-
-*PARMS
-
-{ID} -- an arbitrary identifier for this printout
-
-{list} -- a list of items to be printed (may be a single item)
-
-*DESC
-
-If passed a single item, {Show} will display it using SysOut().
-The dispayed value will be enclosed with << >> (see below).
-If ID consists of more than one word, it should be quoted.
-
-If there are two arguments, the first should be an ID as above, and the second
-should be a list of variables which are bound to values at the place where
-{Show} is called. Using SysOut(), the list of variable names will be printed
-out, along with a list of their currently bound values.
-
-{Show} can be called with any number of variable names in the list.
-
-{Show} always returns {True}.
-
-Because {Show} uses SysOut() to print its output, the output will be visible
-both on Standard Output and also on the Shell console (if MathPiper is started
-this way), or on the MathRider Activity Log (if started in MathRider).
-The latter is very useful for debugging programs which hang in a loop or
-otherwise, because standard output may not then be visible, but the alternative
-output will usually be available.
-
-*E.G. notest
- In> var1:=123
- Result> 123
- In> var2:= "a string"
- Result> "a string"
- In> var3:=Sin(x)+Exp(x)
- Result> Sin(x)+Exp(x)
- In> Show(ID1)
- Result> True
- Side Effects>
- << ID1 >>
- In> Show(ID2,{var1})
- Result> True
- Side Effects>
- << ID2 >> {var1}: {123}
- In> Show(ID3,{var1,var2})
- Result> True
- Side Effects>
- << ID3 >> {var1,var2}: {123,a string}
- In> Show(ID4,{var1,var2,var3})
- Result> True
- Side Effects>
- << ID4 >> {var1,var2,var3}: {123,a string,Sin(x)+Exp(x)}
-
-*SEE Tell
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/TableForm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/TableForm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/TableForm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/TableForm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="TableForm"
-
-Function("TableForm",{list})
-[
- Local(i);
- ForEach(i,list)
- [
- Write(i);
- NewLine();
- ];
- True;
-];
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="TableForm",categories="User Functions;Lists (Operations)"
-*CMD TableForm --- print each entry in a list on a line
-*STD
-*CALL
- TableForm(list)
-
-*PARMS
-
-{list} -- list to print
-
-*DESC
-
-This functions writes out the list {list} in a better readable form, by
-printing every element in the list on a separate line.
-
-*E.G.
-
- In> TableForm(Table(i!, i, 1, 10, 1));
-
- 1
- 2
- 6
- 24
- 120
- 720
- 5040
- 40320
- 362880
- 3628800
- Out> True;
-
-*SEE PrettyForm, Echo, Table
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Tell.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Tell.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/io/Tell.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/io/Tell.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,70 +0,0 @@
-%mathpiper,def="Tell"
-Macro("Tell",{id}) [Echo(<<,@id,>>);];
-Macro("Tell",{id,x}) [Echo(<<,@id,>>,Hold(@x),": ",Eval(@x));];
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-%mathpiper_docs,name="Tell",categories="Programmer Functions;Testing"
-
-*CMD Tell --- debug routine using Echo to print ID and (optional) variable(s)
-
-*STD
-*CALL
- Tell(ID)
- Tell(ID,list)
-
-*PARMS
-
-{ID} -- an arbitrary identifier for this printout
-
-{list} -- a list of items to be printed (may be a single item)
-
-*DESC
-
-If passed a single item, {Tell} will display it using Echo().
-The dispayed value will be enclosed with << >> (see below).
-If ID consists of more than one word, it should be quoted.
-
-If there are two arguments, the first should be an ID as above, and the second
-should be a list of variables which are bound to values at the place where
-{Tell} is called. Using Echo(), the list of variable names will be printed
-out, along with a list of their currently bound values.
-
-{Tell} can be called with any number of variable names in the list.
-
-{Tell} always returns {True}.
-
-Because {Tell} uses Echo(), it prints to Standard Output. If you are debuging
-a program which may hang, you may get no printout. In that case, use {Show}
-instead of {Tell}
-
-*E.G. notest
- In> var1:=123
- Result> 123
- In> var2:= "a string"
- Result> "a string"
- In> var3:=Sin(x)+Exp(x)
- Result> Sin(x)+Exp(x)
- In> Tell(ID1)
- Result> True
- Side Effects>
- << ID1 >>
- In> Tell(ID2,{var1})
- Result> True
- Side Effects>
- << ID2 >> {var1} : {123}
- In> Tell(ID3,{var1,var2})
- Result> True
- Side Effects>
- << ID3 >> {var1,var2} {123,"a string"}
- In> Tell(ID4,{var1,var2,var3})
- Result> True
- Side Effects>
- << ID4 >> {var1,var2,var3} : {123,"a string",Sin(x)+Exp(x)}
-
-
-*SEE Show
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/limit/Limit.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/limit/Limit.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/limit/Limit.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/limit/Limit.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,209 +0,0 @@
-%mathpiper,def="Limit"
-
-/* */
-/* Limit operator rule base */
-/* */
-
-
-/* Exponentiation rules */
-
-/* Special limit #1: 0 ^ 0; #2: 1 ^ Infinity; #3: Infinity ^ 0 */
-200 # Lim(_var, _tar, _dir, _x ^ _y)_
-( [
- Local(lx,ly); lx := Lim(var, tar, dir, x); ly := Lim(var, tar, dir, y);
- ((IsZero(lx) And IsZero(ly)) Or ((lx = 1) And IsInfinity(ly)) Or (IsInfinity(lx) And IsZero(ly)));
-] )
-<-- Exp(Lim(var, tar, dir, y * Ln(x)));
-
-/* Default rule */
-210 # Lim(_var, _tar, _dir, _x ^ _y)
-<-- Lim(var, tar, dir, x)^Lim(var, tar, dir, y);
-
-
-/* Division rules */
-
-/* Special limit #4: 0 / 0; #5: Infinity / Infinity */
-300 # Lim(_var, _tar, _dir, _x / _y)_
-( [
- Local(lx,ly,infx,infy);
- lx := Lim(var, tar, dir, x);
- ly := Lim(var, tar, dir, y);
- infx := (IsInfinity(lx) Or (IsZero(Re(lx)) And IsInfinity(Im(lx))));
- infy := (IsInfinity(ly) Or (IsZero(Re(ly)) And IsInfinity(Im(ly))));
- ((IsZero(lx) And IsZero(ly)) Or
- (infx And infy)
- );
-] )
-<-- Lim(var, tar, dir, ApplyPure("D", {var, x})/ApplyPure("D", {var, y}));
-
-/* Special limit #6: null denominator */
-/* Probably there are still some problems. */
-
-Dir(Right) <-- 1;
-Dir(Left) <-- -1;
-
-/* To get the sign of the denominator on one side: */
-Sign(_var, _tar, _dir, _exp, _n)
-<-- [
- Local(der, coef); der := ApplyPure("D", {var, exp});
- coef := Eval(ApplyPure("Subst", {var, tar, der}));
- If ( coef = 0,
- Sign(var, tar, dir, der, n+1),
- (Sign(coef)*Dir(dir)) ^ n
- );
-];
-
-/* To avoid infinite recursion (with 1/Exp(-x) for instance) */
-310 # Lim(_var, _tar, _dir, _x / _y)_
-(IsInfinity(tar) And IsZero(Lim(var, tar, dir, y)))
-<-- Sign(Lim(var, tar, dir, x))*Sign(Lim(var, tar, dir, ApplyPure("D", {var, y})))*tar;
-
-320 # Lim(_var, _tar, _dir, _x / _y)_IsZero(Lim(var, tar, dir, y))
-<-- Sign(Lim(var, tar, dir, x))*Sign(var, tar, dir, y, 1)*Infinity;
-
-
-/* Default rule */
-330 # Lim(_var, _tar, _dir, _x / _y)
-<-- Lim(var, tar, dir, x)/Lim(var, tar, dir, y); ];
-
-
-/* Multiplication rules */
-
-/* To avoid some infinite recursions */
-400 # Lim(_var, _tar, _dir, _x * Exp(_y))_
-(IsInfinity(Lim(var, tar, dir, x)) And (Lim(var, tar, dir, y) = -Infinity))
-<-- Lim(var, tar, dir, x/Exp(-y));
-400 # Lim(_var, _tar, _dir, Exp(_x) * _y)_
-((Lim(var, tar, dir, x) = -Infinity) And IsInfinity(Lim(var, tar, dir, y)))
-<-- Lim(var, tar, dir, y/Exp(-x));
-400 # Lim(_var, _tar, _dir, Ln(_x) * _y)_
-(IsZero(Lim(var, tar, dir, x)) And IsZero(Lim(var, tar, dir, y)))
-<-- Lim(var, tar, dir, y*Ln(x));
-
-/* Special limit #7: 0 * Infinity */
-410 # Lim(_var, _tar, _dir, _x * _y)_
-((IsZero(Lim(var, tar, dir, x)) And IsInfinity(Lim(var, tar, dir, y)))
- Or (IsInfinity(Lim(var, tar, dir, x)) And IsZero(Lim(var, tar, dir, y))))
-<-- Lim(var, tar, dir, Simplify(ApplyPure("D", {var, y})/ApplyPure("D",
-{var, 1/x})));
-
-/* Default rule */
-420 # Lim(_var, _tar, _dir, _x * _y)
-<-- Lim(var, tar, dir, x) * Lim(var, tar, dir, y);
-
-
-/* Substraction rules */
-
-/* Special limit #8: Infinity - Infinity */
-500 # Lim(_var, _tar, _dir, _x - _y)_
-( [
- Local(lx,ly); lx := Lim(var, tar, dir, x); ly := Lim(var, tar, dir, y);
- ((lx = Infinity) And (ly = Infinity)) Or ((lx = -Infinity) And (ly = -Infinity));
-] )
-<-- Lim(var, tar, dir, x*(1-y/x));
-
-/* Default rule */
-510 # Lim(_var, _tar, _dir, _x - _y)
-<-- Lim(var, tar, dir, x)-Lim(var, tar, dir, y);
-
-/* Unary minus */
-520 # Lim(_var, _tar, _dir, - _x)
-<-- - Lim(var, tar, dir, x);
-
-
-/* Addition rules */
-
-/* Special limit #9: Infinity + (-Infinity) */
-600 # Lim(_var, _tar, _dir, _x + _y)_
-( [
- Local(lx,ly); lx := Lim(var, tar, dir, x); ly := Lim(var, tar, dir, y);
- ((lx = Infinity) And (ly = -Infinity)) Or ((lx = -Infinity) And (ly = Infinity));
-] )
-<-- Lim(var, tar, dir, x*(1+y/x));
-
-/* Default rule */
-610 # Lim(_var, _tar, _dir, _x + _y)
-<-- Lim(var, tar, dir, x)+Lim(var, tar, dir, y);
-
-/* Global default rule : evaluate expression */
-
-700 # Lim(_var, _tar, _dir, exp_IsFunction)
-<-- Eval(MapArgs(exp,"LimitArgs"));
-
-LimitArgs(_arg) <-- Lim(var,tar,dir,arg);
-UnFence("LimitArgs",1); /* Allow LimitArgs to have access to the local variables of the caller. */
-
-701 # Lim(_var, _tar, _dir, _exp)
-<-- Eval(ApplyPure("Subst", {var, tar, exp}));
-
-
-/* Limit without direction */
-
-10 # Lim(_var, tar_IsInfinity, _exp) <-- Lim(var, tar, None, exp);
-
-20 # Lim(_var, _tar, _exp)
-<-- [
- Local(l); l := Lim(var, tar, Left, exp);
- If ( l = Lim(var, tar, Right, exp),
- l,
- Undefined
- );
-];
-
-
-
-
-/* User-callable function */
-
-(Limit(_var,_lim)(_fie)) <-- Lim(var,lim,fie);
-(Limit(_var,_lim,_direction)(_fie)) <-- Lim(var,lim,direction,fie);
-UnFence("Limit",3);
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Limit",categories="User Functions;Calculus Related (Symbolic)"
-*CMD Limit --- limit of an expression
-*STD
-*CALL
- Limit(var, val) expr
- Limit(var, val, dir) expr
-
-*PARMS
-
-{var} -- a variable
-
-{val} -- a number
-
-{dir} -- a direction ({Left} or {Right})
-
-{expr} -- an expression
-
-*DESC
-
-This command tries to determine the value that the expression "expr"
-converges to when the variable "var" approaches "val". One may use
-{Infinity} or {-Infinity} for
-"val". The result of {Limit} may be one of the
-symbols {Undefined} (meaning that the limit does not
-exist), {Infinity}, or {-Infinity}.
-
-The second calling sequence is used for unidirectional limits. If one
-gives "dir" the value {Left}, the limit is taken as
-"var" approaches "val" from the positive infinity; and {Right} will take the limit from the negative infinity.
-
-*E.G.
-
- In> Limit(x,0) Sin(x)/x
- Out> 1;
- In> Limit(x,0) (Sin(x)-Tan(x))/(x^3)
- Out> -1/2;
- In> Limit(x,0) 1/x
- Out> Undefined;
- In> Limit(x,0,Left) 1/x
- Out> -Infinity;
- In> Limit(x,0,Right) 1/x
- Out> Infinity;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/limit/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/limit/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/limit/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/limit/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef("Limit", "limit1","limit",
- { _0, _2, OMS("limit1", "under"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Left)
- |{ _0, _2, OMS("limit1", "above"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Right)
- |{ _0, _2, OMS("limit1", "both_sides"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _3) },
- { _0, _{3,2,1}, _1, Left, _{3,3}}_(_2=OMS("limit1", "below"))
- |{_0, _{3,2,1}, _1, Right, _{3,3}}_(_2=OMS("limit1", "above"))
- |{_0, _{3,2,1}, _1, _{3,3}}
- );
-// Test [result Limit(x,0,Right)1/x]: FromString(ToString()OMForm(Limit(x,0,Right) 1/x))OMRead()
-
-// As explained in the manual, "limit1:both_sides" and "fns1:lambda" will
-// be handled as OMS("limit1", "both_sides") and OMS("fns1", "lambda"), so
-// we don't need to define bogus mappings for them:
-// OMDef("OMSymbolLimit1BothSides", "limit1", "both_sides");
-// OMDef("OMSymbolLambda", "fns1", "lambda");
-// The same applies to "Left" and "Right", which are undefined symbols
-// that are used only inside limit expressions, so they don't need a mapping
-// of their own.
-// We could define them as follows:
-//OMDef("Left", "limit1","below");
-//OMDef("Right", "limit1","above");
-// and then use the following rules instead:
-// { _0, _2, Left, OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Left)
-// |{ _0, _2, Right, OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Right)
-// |{ _0, _2, OMS("limit1", "both_sides"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _3) },
-// { _0, _{3,2,1}, _1, _2, _{3,3}}_(_2=Left Or _2=Right)
-// |{_0, _{3,2,1}, _1, _{3,3}}
-// The result is exactly the same. The only difference is when producing the
-// OMForm of the symbols themselves, outside the limit expression.
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/BaseVector.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/BaseVector.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/BaseVector.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/BaseVector.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="BaseVector"
-
-Function("BaseVector",{row,n})
-[
- Local(i,result);
- result:=ZeroVector(n);
- result[row] := 1;
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="BaseVector",categories="User Functions;Linear Algebra"
-*CMD BaseVector --- base vector
-*STD
-*CALL
- BaseVector(k, n)
-
-*PARMS
-
-{k} -- index of the base vector to construct
-
-{n} -- dimension of the vector
-
-*DESC
-
-This command returns the "k"-th base vector of dimension "n". This
-is a vector of length "n" with all zeroes except for the "k"-th
-entry, which contains a 1.
-
-*E.G.
-
- In> BaseVector(2,4)
- Out> {0,1,0,0};
-
-*SEE ZeroVector, Identity
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Cholesky.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Cholesky.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Cholesky.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Cholesky.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,79 +0,0 @@
-%mathpiper,def="Cholesky"
-
-// Cholesky Decomposition, adapted from:
-// Fundamentals Of Matrix Computation (2nd), David S. Watkins, pp38
-// This algorithm performs O(n^3) flops where A is nxn
-// Given the positive definite matrix A, a matrix R is returned such that
-// A = Transpose(R) * R
-
-10 # Cholesky(A_IsMatrix) <--
-[
- Local(matrix,n,k,j);
- n:=Length(A);
- matrix:=ZeroMatrix(n);
-
- // copy entries of A into matrix
- ForEach(i,1 .. n)
- ForEach(j,1 .. n)
- matrix[i][j] := A[i][j];
-
- // in place algorithm for cholesky decomp
- ForEach(i,1 .. n)[
- For(k:=1,k<=(i-1),k++)
- matrix[i][i] := matrix[i][i] - matrix[k][i]^2;
- Check( matrix[i][i] > 0, "Cholesky: Matrix is not positive definite");
- matrix[i][i] := Sqrt(matrix[i][i]);
- //Echo({"matrix[",i,"][",i,"] = ", matrix[i][i] });
- For(j:=i+1,j<=n,j++)[
- For(k:=1,k<=(i-1),k++)
- matrix[i][j]:= matrix[i][j] - matrix[k][i]*matrix[k][j];
- matrix[i][j] := matrix[i][j]/matrix[i][i];
- //Echo({"matrix[",i,"][",j,"] = ", matrix[i][j] });
- ];
- ];
- // cholesky factorization is upper triangular
- ForEach(i,1 .. n)
- ForEach(j,1 .. n)
- If(i>j,matrix[i][j] := 0);
- matrix;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Cholesky",categories="User Functions;Linear Algebra"
-*CMD Cholesky --- find the Cholesky Decomposition
-*STD
-*CALL
- Cholesky(A)
-
-*PARMS
-
-{A} -- a square positive definite matrix
-
-*DESC
-
-{Cholesky} returns a upper triangular matrix {R} such that {Transpose(R)*R = A}.
-The matrix {A} must be positive definite, {Cholesky} will notify the user if the matrix
-is not. Some families of positive definite matrices are all symmetric matrices, diagonal
-matrices with positive elements and Hilbert matrices.
-
-*E.G.
-
- In> A:={{4,-2,4,2},{-2,10,-2,-7},{4,-2,8,4},{2,-7,4,7}}
- Out> {{4,-2,4,2},{-2,10,-2,-7},{4,-2,8,4},{2,-7,4,7}};
- In> R:=Cholesky(A);
- Out> {{2,-1,2,1},{0,3,0,-2},{0,0,2,1},{0,0,0,1}};
- In> Transpose(R)*R = A
- Out> True;
- In> Cholesky(4*Identity(5))
- Out> {{2,0,0,0,0},{0,2,0,0,0},{0,0,2,0,0},{0,0,0,2,0},{0,0,0,0,2}};
- In> Cholesky(HilbertMatrix(3))
- Out> {{1,1/2,1/3},{0,Sqrt(1/12),Sqrt(1/12)},{0,0,Sqrt(1/180)}};
- In> Cholesky(ToeplitzMatrix({1,2,3}))
- In function "Check" :
- CommandLine(1) : "Cholesky: Matrix is not positive definite"
-
-*SEE IsSymmetric, IsDiagonal, Diagonal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/CoFactor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/CoFactor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/CoFactor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/CoFactor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,62 +0,0 @@
-%mathpiper,def="CoFactor"
-
-Function("CoFactor",{matrix,ii,jj})
-[
- Local(perms,indices,result);
- indices:=Table(i,i,1,Length(matrix),1);
- perms:=PermutationsList(indices);
- result:=0;
- ForEach(item,perms)
- If(item[ii] = jj,
- result:=result+
- Product(i,1,Length(matrix),
- If(ii=i,1,matrix[i][item[i] ])
- )*LeviCivita(item));
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="CoFactor",categories="User Functions;Linear Algebra"
-*CMD CoFactor --- cofactor of a matrix
-*STD
-*CALL
- CoFactor(M,i,j)
-
-*PARMS
-
-{M} -- a matrix
-
-{i}, {j} - positive integers
-
-*DESC
-
-{CoFactor} returns the cofactor of a matrix around
-the element ($i$, $j$). The cofactor is the minor times
-$(-1)^(i+j)$.
-
-*E.G.
-
- In> A := {{1,2,3}, {4,5,6}, {7,8,9}};
- Out> {{1,2,3},{4,5,6},{7,8,9}};
- In> PrettyForm(A);
-
- / \
- | ( 1 ) ( 2 ) ( 3 ) |
- | |
- | ( 4 ) ( 5 ) ( 6 ) |
- | |
- | ( 7 ) ( 8 ) ( 9 ) |
- \ /
- Out> True;
- In> CoFactor(A,1,2);
- Out> 6;
- In> Minor(A,1,2);
- Out> -6;
- In> Minor(A,1,2) * (-1)^(1+2);
- Out> 6;
-
-*SEE Minor, Determinant, Inverse
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/CrossProduct.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/CrossProduct.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/CrossProduct.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/CrossProduct.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="CrossProduct"
-
-Function("CrossProduct",{aLeft,aRight})
-[
- Local(length);
- length:=Length(aLeft);
- Check(length = 3,"OutProduct: error, vectors not of dimension 3");
- Check(length = Length(aRight),"OutProduct: error, vectors not of the same dimension");
-
- Local(perms);
- perms := PermutationsList({1,2,3});
-
- Local(result);
- result:=ZeroVector(3);
-
- Local(term);
- ForEach(term,perms)
- [
- result[ term[1] ] := result[ term[1] ] +
- LeviCivita(term) * aLeft[ term[2] ] * aRight[ term[3] ] ;
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="CrossProduct",categories="User Functions;Linear Algebra"
-*CMD CrossProduct --- outer product of vectors
-*STD
-*CALL
- CrossProduct(a,b)
- a X b
-Precedence:
-*EVAL OpPrecedence("X")
-
-*PARMS
-
-{a}, {b} -- three-dimensional vectors
-
-*DESC
-
-The cross product of the vectors "a"
-and "b" is returned. The result is perpendicular to both "a" and
-"b" and its length is the product of the lengths of the vectors.
-Both "a" and "b" have to be three-dimensional.
-
-*E.G.
-
- In> {a,b,c} X {d,e,f};
- Out> {b*f-c*e,c*d-a*f,a*e-b*d};
-
-*SEE InProduct
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Deteminant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Deteminant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Deteminant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Deteminant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-%mathpiper,def="Determinant"
-
-10 # Determinant(_matrix)_(IsUpperTriangular(matrix) Or IsLowerTriangular(matrix)) <--
-[
- Local(result);
- result:=1;
- ForEach(i, Diagonal(matrix) )
- result:=result*i;
- result;
-];
-
-//
-// The fast determinant routine that does the determinant numerically, rule 20,
-// divides things by the elements on the diagonal of the matrix. So if one of these
-// elements happens to be zero, the result is something like Infinity or Undefined.
-// Use the symbolic determinant in that case, as it is slower but much more robust.
-//
-15 # Determinant(_matrix)_(Length(Select("IsZero",Diagonal(matrix))) > 0) <-- SymbolicDeterminant(matrix);
-
-// Not numeric entries, so lets treat it symbolically.
-16 # Determinant(_matrix)_(VarList(matrix) != {}) <-- SymbolicDeterminant(matrix);
-
-20 # Determinant(_matrix) <-- GaussianDeterminant(matrix);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Determinant",categories="User Functions;Linear Algebra"
-*CMD Determinant --- determinant of a matrix
-*STD
-*CALL
- Determinant(M)
-
-*PARMS
-
-{M} -- a matrix
-
-*DESC
-
-Returns the determinant of a matrix M.
-
-*E.G.
-
- In> A:=DiagonalMatrix(1 .. 4)
- Out> {{1,0,0,0},{0,2,0,0},{0,0,3,0},{0,0,0,4}};
- In> Determinant(A)
- Out> 24;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/DiagonalMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/DiagonalMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/DiagonalMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/DiagonalMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="DiagonalMatrix"
-
-Function("DiagonalMatrix",{list})
-[
- Local(result,i,n);
- n:=Length(list);
- result:=Identity(n);
- For(i:=1,i<=n,i++)
- [
- result[i][i] := list[i];
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="DiagonalMatrix",categories="User Functions;Linear Algebra"
-*CMD DiagonalMatrix --- construct a diagonal matrix
-*STD
-*CALL
- DiagonalMatrix(d)
-
-*PARMS
-
-{d} -- list of values to put on the diagonal
-
-*DESC
-
-This command constructs a diagonal matrix, that is a square matrix
-whose off-diagonal entries are all zero. The elements of the vector
-"d" are put on the diagonal.
-
-*E.G.
-
- In> DiagonalMatrix(1 .. 4)
- Out> {{1,0,0,0},{0,2,0,0},{0,0,3,0},{0,0,0,4}};
-
-*SEE Identity, ZeroMatrix
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Diagonal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Diagonal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Diagonal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Diagonal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="Diagonal"
-
-//
-// Diagonal: return a vector with the diagonal elements of the matrix
-//
-Function("Diagonal",{A})
-[
- Local(result,i,n);
- n:=Length(A);
- result:=ZeroVector(n);
- For(i:=1,i<=n,i++)
- [
- result[i] := A[i][i];
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Diagonal",categories="User Functions;Linear Algebra"
-*CMD Diagonal --- extract the diagonal from a matrix
-*STD
-*CALL
- Diagonal(A)
-
-*PARMS
-
-{A} -- matrix
-
-*DESC
-
-This command returns a vector of the diagonal components
-of the matrix {A}.
-
-
-*E.G.
-
- In> Diagonal(5*Identity(4))
- Out> {5,5,5,5};
- In> Diagonal(HilbertMatrix(3))
- Out> {1,1/3,1/5};
-
-*SEE DiagonalMatrix, IsDiagonal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Dimensions.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Dimensions.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Dimensions.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Dimensions.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="Dimensions"
-
-/* Code that returns the list of the dimensions of a tensor
- Code submitted by Dirk Reusch.
- */
-
-LocalSymbols(x,i,n,m,aux,dim,result)
-[
-1 # Dimensions(x_IsList) <--
- [
- Local(i,n,m,aux,dim,result);
- result:=List(Length(x));
-//Echo("GETTING ",x);
-//Echo(Length(Select(IsList,x)));
-//Echo("END");
- If(Length(x)>0 And Length(Select(IsList,x))=Length(x),
- [
- n:=Length(x);
- dim:=MapSingle(Dimensions,x);
- m:=Min(MapSingle(Length,dim));
-
- For(i:=1,i<=m,i++)
- [
- aux:=Table(dim[j][i],j,1,n,1);
- If(Min(aux)=Max(aux),
- result:=DestructiveAppend(result,dim[1][i]),
- i:=m+1);
- ];
- ]);
-//Echo(x,result);
- result;
- ];
-
-2 # Dimensions(_x) <-- List();
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Dot.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Dot.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Dot.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Dot.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,117 +0,0 @@
-%mathpiper,def="Dot"
-
-//////
-// dot product for vectors and matrices (dr)
-//////
-
-LocalSymbols(Dot0,Dot1)
-[
-// vector . vector
-Dot(t1_IsVector,t2_IsVector)_(Length(t1)=Length(t2)) <--
- Dot0(t1,t2,Length(t1));
-
-// matrix . vector
-Dot(t1_IsMatrix,t2_IsVector)_(Length(t1[1])=Length(t2)) <--
-[
- Local(i,n,m,result);
- n:=Length(t1);
- m:=Length(t2);
- result:=List();
- For(i:=1,i<=n,i++)
- DestructiveInsert(result,1,Dot0(t1[i],t2,m));
- DestructiveReverse(result);
-];
-
-// vector . matrix
-Dot(t1_IsVector,t2_IsMatrix)_(Length(t1)=Length(t2)
- And Length(t2[1])>0) <--
- Dot1(t1,t2,Length(t1),Length(t2[1]));
-
-// matrix . matrix
-Dot(t1_IsMatrix,t2_IsMatrix)_(Length(t1[1])=Length(t2)
- And Length(t2[1])>0) <--
-[
- Local(i,n,k,l,result);
- n:=Length(t1);
- k:=Length(t2);
- l:=Length(t2[1]);
- result:=List();
- For(i:=1,i<=n,i++)
- DestructiveInsert(result,1,Dot1(t1[i],t2,k,l));
- DestructiveReverse(result);
-];
-
-// vector . vector
-Dot0(_t1,_t2,_n) <--
-[
- Local(i,result);
- result:=0;
- For(i:=1,i<=n,i++)
- result:=result+t1[i]*t2[i];
- result;
-];
-
-// vector . matrix
-// m vector length
-// n number of matrix cols
-Dot1(_t1,_t2,_m,_n) <--
-[
- Local(i,j,result);
- result:=ZeroVector(n);
- For(i:=1,i<=n,i++)
- For(j:=1,j<=m,j++)
- result[i]:=result[i]+t1[j]*t2[j][i];
- result;
-];
-
-]; // LocalSymbols(Dot0,Dot1)
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Dot",categories="User Functions;Linear Algebra"
-*CMD Dot, . --- get dot product of tensors
-*STD
-*CALL
- Dot(t1,t2)
- t1 . t2
-Precedence:
-*EVAL OpPrecedence(".")
-
-*PARMS
-
-{t1,t2} -- tensor lists (currently only vectors and matrices are supported)
-
-*DESC
-
-{Dot} returns the dot (aka inner) product of two tensors t1 and t2. The last
-index of t1 and the first index of t2 are contracted. Currently {Dot} works
-only for vectors and matrices. {Dot}-multiplication of two vectors, a matrix
-with a vector (and vice versa) or two matrices yields either a scalar, a
-vector or a matrix.
-
-*E.G.
-
- In> Dot({1,2},{3,4})
- Out> 11;
- In> Dot({{1,2},{3,4}},{5,6})
- Out> {17,39};
- In> Dot({5,6},{{1,2},{3,4}})
- Out> {23,34};
- In> Dot({{1,2},{3,4}},{{5,6},{7,8}})
- Out> {{19,22},{43,50}};
-
- Or, using the "."-Operator:
-
- In> {1,2} . {3,4}
- Out> 11;
- In> {{1,2},{3,4}} . {5,6}
- Out> {17,39};
- In> {5,6} . {{1,2},{3,4}}
- Out> {23,34};
- In> {{1,2},{3,4}} . {{5,6},{7,8}}
- Out> {{19,22},{43,50}};
-
-*SEE Outer, Cross, IsScalar, IsVector, IsMatrix, .
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/FrobeniusNorm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/FrobeniusNorm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/FrobeniusNorm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/FrobeniusNorm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-%mathpiper,def="FrobeniusNorm"
-
-FrobeniusNorm(matrix_IsMatrix) <--
-[
- Local(i,j,result);
- result:=0;
- For(i:=1,i<=Length(matrix),i++)
- For(j:=1,j<=Length(matrix[1]),j++)
- result:=result+Abs(matrix[i][j])^2;
-
- Sqrt(result);
-
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/GaussianDeterminant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/GaussianDeterminant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/GaussianDeterminant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/GaussianDeterminant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="GaussianDeterminant",scope="private"
-
-GaussianDeterminant(matrix):=
-[
- Local(n,s,result);
- n:=Length(matrix);
- result:=1;
-
- [
- matrix:=FlatCopy(matrix);
- Local(i);
- For(i:=1,i<=n,i++)
- [
- matrix[i]:=FlatCopy(matrix[i]);
- ];
- ];
-
- // gaussian elimination
- ForEach(i, 1 .. (n-1) )
- [
- ForEach(k, (i+1) .. n )
- [
- s:=matrix[k][i];
- ForEach(j, i .. n )
- [
- matrix[k][j] := matrix[k][j] - (s/matrix[i][i])*matrix[i][j];
- //Echo({"matrix[",k,"][",j,"] =", aug[k][j]," - ",
- // matrix[k][i],"/",matrix[i][i],"*",matrix[i][j]," k i =", k,i });
- ];
- ];
- ];
-
-//Echo("mat: ",matrix);
-//Echo("diagmat: ",Diagonal(matrix));
- // now upper triangular
- ForEach(i, Diagonal(matrix) )
- result:=result*i;
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/GenMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/GenMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/GenMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/GenMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-%mathpiper,def="GenMatrix"
-
-Function("GenMatrix",{func,m,n})
-[
- Local(i,j,result);
- result:=ZeroMatrix(m,n);
-
- For(i:=1,i<=m,i++)
- For(j:=1,j<=n,j++)
- result[i][j]:=ApplyPure(func,{i,j});
-
- result;
-];
-HoldArg("GenMatrix",func);
-UnFence("GenMatrix",3);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HankelMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HankelMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HankelMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HankelMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-%mathpiper,def="HankelMatrix"
-
-// The arguments of the following functions should be checked
-HankelMatrix(n):=GenMatrix({{i,j}, If(i+j-1>n,0,i+j-1) }, n,n );
-HankelMatrix(m,n):=GenMatrix({{i,j}, If(i+j-1>n,0,i+j-1)}, m,n );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HessianMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HessianMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HessianMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HessianMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,48 +0,0 @@
-%mathpiper,def="HessianMatrix"
-
-// The arguments of the following functions should be checked
-// this takes 1 func in N vars
-HessianMatrix(f,v):=GenMatrix({{i,j}, Deriv(v[i]) Deriv(v[j]) f},Length(v),Length(v));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HessianMatrix",categories="User Functions;Matrices (Special)"
-*CMD HessianMatrix --- create the Hessian matrix
-*STD
-*CALL
- HessianMatrix(function,var)
-*PARMS
-
-{function} -- a function in $n$ variables
-
-{var} -- an $n$-dimensional vector of variables
-
-*DESC
-
-The function {HessianMatrix} calculates the Hessian matrix
-of a vector.
-
-If $f(x)$ is a function of an $n$-dimensional vector $x$, then the ($i$,$j$)-th element of the Hessian matrix of the function $f(x)$ is defined as
-$ Deriv(x[i]) Deriv(x[j]) f(x) $. If the third
-order mixed partials are continuous, then the Hessian
-matrix is symmetric (a standard theorem of calculus).
-
-The Hessian matrix is used in the second derivative test
-to discern if a critical point is a local maximum, a local
-minimum or a saddle point.
-
-
-*E.G.
-
- In> HessianMatrix(3*x^2-2*x*y+y^2-8*y, {x,y} )
- Out> {{6,-2},{-2,2}};
- In> PrettyForm(%)
-
- / \
- | ( 6 ) ( -2 ) |
- | |
- | ( -2 ) ( 2 ) |
- \ /
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HilbertInverseMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HilbertInverseMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HilbertInverseMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HilbertInverseMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="HilbertInverseMatrix"
-
-HilbertInverseMatrix(n):=GenMatrix({{i,j},
- (-1)^(i+j)*(i+j-1)*BinomialCoefficient(n+i-1,n-j)*BinomialCoefficient(n+j-1,n-i)*BinomialCoefficient(i+j-2,i-1)^2},n,n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HilbertInverseMatrix",categories="User Functions;Matrices (Special)"
-*CMD HilbertInverseMatrix --- create a Hilbert inverse matrix
-*STD
-*CALL
- HilbertInverseMatrix(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-The function {HilbertInverseMatrix} returns the {n} by {n} inverse of the
-corresponding Hilbert matrix. All Hilbert inverse matrices have integer
-entries that grow in magnitude rapidly.
-
-*E.G.
- In> PrettyForm(HilbertInverseMatrix(4))
-
- / \
- | ( 16 ) ( -120 ) ( 240 ) ( -140 ) |
- | |
- | ( -120 ) ( 1200 ) ( -2700 ) ( 1680 ) |
- | |
- | ( 240 ) ( -2700 ) ( 6480 ) ( -4200 ) |
- | |
- | ( -140 ) ( 1680 ) ( -4200 ) ( 2800 ) |
- \ /
-
-*SEE HilbertMatrix
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HilbertMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HilbertMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/HilbertMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/HilbertMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-%mathpiper,def="HilbertMatrix"
-
-// The arguments of the following functions should be checked
-// notoriously hard to manipulate numerically
-HilbertMatrix(n):=GenMatrix({{i,j}, 1/(i+j-1)}, n,n );
-HilbertMatrix(m,n):=GenMatrix({{i,j}, 1/(i+j-1)}, m,n );
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HilbertMatrix",categories="User Functions;Matrices (Special)"
-*CMD HilbertMatrix --- create a Hilbert matrix
-*STD
-*CALL
- HilbertMatrix(n)
- HilbertMatrix(n,m)
-*PARMS
-
-{n,m} -- positive integers
-
-*DESC
-
-The function {HilbertMatrix} returns the {n} by {m} Hilbert matrix
-if given two arguments, and the square {n} by {n} Hilbert matrix
-if given only one. The Hilbert matrix is defined as {A(i,j) = 1/(i+j-1)}.
-The Hilbert matrix is extremely sensitive to manipulate and invert numerically.
-
-*E.G.
-
- In> PrettyForm(HilbertMatrix(4))
-
- / \
- | ( 1 ) / 1 \ / 1 \ / 1 \ |
- | | - | | - | | - | |
- | \ 2 / \ 3 / \ 4 / |
- | |
- | / 1 \ / 1 \ / 1 \ / 1 \ |
- | | - | | - | | - | | - | |
- | \ 2 / \ 3 / \ 4 / \ 5 / |
- | |
- | / 1 \ / 1 \ / 1 \ / 1 \ |
- | | - | | - | | - | | - | |
- | \ 3 / \ 4 / \ 5 / \ 6 / |
- | |
- | / 1 \ / 1 \ / 1 \ / 1 \ |
- | | - | | - | | - | | - | |
- | \ 4 / \ 5 / \ 6 / \ 7 / |
- \ /
-
-*SEE HilbertInverseMatrix
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Identity.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Identity.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Identity.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Identity.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="Identity"
-
-Identity(n_IsNonNegativeInteger) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=n,i++)
- [
- DestructiveAppend(result,BaseVector(i,n));
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Identity",categories="User Functions;Linear Algebra"
-*CMD Identity --- make identity matrix
-*STD
-*CALL
- Identity(n)
-
-*PARMS
-
-{n} -- size of the matrix
-
-*DESC
-
-This commands returns the identity matrix of size "n" by "n". This
-matrix has ones on the diagonal while the other entries are zero.
-
-*E.G.
-
- In> Identity(3)
- Out> {{1,0,0},{0,1,0},{0,0,1}};
-
-*SEE BaseVector, ZeroMatrix, DiagonalMatrix
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/InProduct.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/InProduct.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/InProduct.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/InProduct.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="InProduct"
-
-Function("InProduct",{aLeft,aRight})
-[
- Local(length);
- length:=Length(aLeft);
- Check(length = Length(aRight),"InProduct: error, vectors not of the same dimension");
-
- Local(result);
- result:=0;
- Local(i);
- For(i:=1,i<=length,i++)
- [
- result := result + aLeft[i] * aRight[i];
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="InProduct",categories="User Functions;Linear Algebra"
-*CMD InProduct --- inner product of vectors (deprecated)
-*STD
-*CALL
- InProduct(a,b)
-
-*PARMS
-
-{a}, {b} -- vectors of equal length
-
-*DESC
-
-The inner product of the two vectors "a" and "b" is returned. The
-vectors need to have the same size.
-
-This function is superceded by the {.} operator.
-
-*E.G.
-
- In> {a,b,c} . {d,e,f};
- Out> a*d+b*e+c*f;
-
-*SEE Dot, CrossProduct
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Inverse.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Inverse.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Inverse.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Inverse.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,59 +0,0 @@
-%mathpiper,def="Inverse"
-
-Function("Inverse",{matrix})
-[
- Local(perms,indices,inv,det,n);
- n:=Length(matrix);
- indices:=Table(i,i,1,n,1);
- perms:=PermutationsList(indices);
- inv:=ZeroMatrix(n,n);
- det:=0;
- ForEach(item,perms)
- [
- Local(i,lc);
- lc := LeviCivita(item);
- det:=det+Product(i,1,n,matrix[i][item[i] ])* lc;
- For(i:=1,i<=n,i++)
- [
- inv[item[i] ][i] := inv[item[i] ][i]+
- Product(j,1,n,
- If(j=i,1,matrix[j][item[j] ]))*lc;
- ];
- ];
- Check(det != 0, "Zero determinant");
- (1/det)*inv;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Inverse",categories="User Functions;Linear Algebra"
-*CMD Inverse --- get inverse of a matrix
-*STD
-*CALL
- Inverse(M)
-
-*PARMS
-
-{M} -- a matrix
-
-*DESC
-
-Inverse returns the inverse of matrix $M$. The determinant of $M$ should
-be non-zero. Because this function uses {Determinant} for calculating
-the inverse of a matrix, you can supply matrices with non-numeric (symbolic)
-matrix elements.
-
-*E.G.
-
- In> A:=DiagonalMatrix({a,b,c})
- Out> {{a,0,0},{0,b,0},{0,0,c}};
- In> B:=Inverse(A)
- Out> {{(b*c)/(a*b*c),0,0},{0,(a*c)/(a*b*c),0},
- {0,0,(a*b)/(a*b*c)}};
- In> Simplify(B)
- Out> {{1/a,0,0},{0,1/b,0},{0,0,1/c}};
-
-*SEE Determinant
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/JacobianMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/JacobianMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/JacobianMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/JacobianMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="JacobianMatrix"
-
-// The arguments of the following functions should be checked
-// this takes N funcs in N vars
-JacobianMatrix(f,v):=GenMatrix({{i,j},Deriv(v[j])f[i]},Length(f),Length(f));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="JacobianMatrix",categories="User Functions;Matrices (Special)"
-*CMD JacobianMatrix --- calculate the Jacobian matrix of $n$ functions in $n$ variables
-*STD
-*CALL
- JacobianMatrix(functions,variables)
-
-*PARMS
-
-{functions} -- an $n$-dimensional vector of functions
-
-{variables} -- an $n$-dimensional vector of variables
-
-*DESC
-
-The function {JacobianMatrix} calculates the Jacobian matrix
-of n functions in n variables.
-
-The ($i$,$j$)-th element of the Jacobian matrix is defined as the derivative
-of $i$-th function with respect to the $j$-th variable.
-
-*E.G.
-
- In> JacobianMatrix( {Sin(x),Cos(y)}, {x,y} );
- Out> {{Cos(x),0},{0,-Sin(y)}};
- In> PrettyForm(%)
-
- / \
- | ( Cos( x ) ) ( 0 ) |
- | |
- | ( 0 ) ( -( Sin( y ) ) ) |
- \ /
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/LeviCivita.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/LeviCivita.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/LeviCivita.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/LeviCivita.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,67 +0,0 @@
-%mathpiper,def="LeviCivita"
-
-/* Levi-civita symbol */
-Function("LeviCivita",{indices})
-[
- Local(i,j,length,left,right,factor);
- length:=Length(indices);
- factor:=1;
-
- For (j:=length,j>1,j--)
- [
- For(i:=1,i LeviCivita({1,2,3})
- Out> 1;
- In> LeviCivita({2,1,3})
- Out> -1;
- In> LeviCivita({2,2,3})
- Out> 0;
-
-*SEE PermutationsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/LU.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/LU.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/LU.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/LU.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="LU"
-
-// In place LU decomposition
-// Pivotting is not implemented
-// Adapted from Numerical Methods with Matlab
-// Gerald Recktenwald, Sec 8.4
-10 # LU(A_IsSquareMatrix) <--
-[
- Local(n,matrix,L,U);
- n:=Length(A);
- L:=ZeroMatrix(n,n);
- U:=ZeroMatrix(n,n);
- matrix:=ZeroMatrix(n,n);
-
- ForEach(i,1 .. n)
- ForEach(j,1 .. n)
- matrix[i][j] := A[i][j];
-
- // loop over pivot rows
- ForEach(i,1 ..(n-1))[
- // loop over column below the pivot
- ForEach(k,i+1 .. n)[
- // compute multiplier and store it in L
- matrix[k][i] := matrix[k][i] / matrix[i][i];
- // loop over elements in row k
- ForEach(j,i+1 .. n)[
- matrix[k][j] := matrix[k][j] - matrix[k][i]*matrix[i][j];
- ];
- ];
- ];
- ForEach(i,1 .. n)[
- ForEach(j,1 .. n)[
- If(i<=j,U[i][j]:=matrix[i][j],L[i][j]:=matrix[i][j]);
- ];
- // diagonal of L is always 1's
- L[i][i]:=1;
- ];
-
- {L,U};
-];
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixColumn.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixColumn.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixColumn.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixColumn.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="MatrixColumn"
-
-Function("MatrixColumn",{matrix,col})
-[
- Local(m);
- m:=matrix[1];
-
- Check(col > 0, "MatrixColumn: column index out of range");
- Check(col <= Length(m), "MatrixColumn: column index out of range");
-
- Local(i,result);
- result:={};
- For(i:=1,i<=Length(matrix),i++)
- DestructiveAppend(result,matrix[i][col]);
-
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixPower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixPower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixPower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixPower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,60 +0,0 @@
-%mathpiper,def="MatrixPower"
-
-//////
-// power of a matrix (dr)
-//////
-
-MatrixPower(x_IsSquareMatrix, n_IsNonNegativeInteger) <--
-[
- Local(result);
- result:=Identity(Length(x));
- While(n != 0)
- [
- If(IsOdd(n),
- result:=Dot(result,x));
- x:=Dot(x,x);
- n:=n>>1;
- ];
- result;
-];
-
-MatrixPower(x_IsSquareMatrix, n_IsNegativeInteger) <--
- MatrixPower(Inverse(x),-n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MatrixPower",categories="User Functions;Linear Algebra"
-*CMD MatrixPower --- get nth power of a square matrix
-*STD
-*CALL
- MatrixPower(mat,n)
-
-*PARMS
-
-{mat} -- a square matrix
-
-{n} -- an integer
-
-*DESC
-
-{MatrixPower(mat,n)} returns the {n}th power of a square matrix {mat}. For
-positive {n} it evaluates dot products of {mat} with itself. For negative
-{n} the nth power of the inverse of {mat} is returned. For {n}=0 the identity
-matrix is returned.
-
-*E.G.
- In> A:={{1,2},{3,4}}
- Out> {{1,2},{3,4}};
- In> MatrixPower(A,0)
- Out> {{1,0},{0,1}};
- In> MatrixPower(A,1)
- Out> {{1,2},{3,4}};
- In> MatrixPower(A,3)
- Out> {{37,54},{81,118}};
- In> MatrixPower(A,-3)
- Out> {{-59/4,27/4},{81/8,-37/8}};
-
-*SEE IsSquareMatrix, Inverse, Dot
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixRow.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixRow.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixRow.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixRow.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-%mathpiper,def="MatrixRow"
-
-Function("MatrixRow",{matrix,row})
-[
- Check(row > 0, "MatrixRow: row index out of range");
- Check(row <= Length(matrix), "MatrixRow: row index out of range");
-
- Local(result);
- result:=matrix[row];
-
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixSolve.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixSolve.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/MatrixSolve.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/MatrixSolve.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,148 +0,0 @@
-%mathpiper,def="MatrixSolve"
-
-10 # MatrixSolve(matrix_IsDiagonal,b_IsVector) <--
-[
- Local(rowsm,rowsb,x);
- rowsm:=Length(matrix);
- rowsb:=Length(b);
- Check(rowsm=rowsb,"MatrixSolve: Matrix and vector must have same number of rows");
- x:=ZeroVector(rowsb);
- ForEach(i,1 .. rowsb)
- x[i]:=b[i]/matrix[i][i];
- x;
-];
-
-// Backward Substitution
-15 # MatrixSolve(matrix_IsUpperTriangular,b_IsVector) <--
-[
- Local(rowsm,rowsb,x,s);
- rowsm:=Length(matrix);
- rowsb:=Length(b);
- Check(rowsm=rowsb,"MatrixSolve: Matrix and vector must have same number of rows");
- x:=ZeroVector(rowsb);
-
- x[rowsb]:=b[rowsb]/matrix[rowsb][rowsb];
- If(InVerboseMode(),Echo({"set x[",rowsb,"] = ",b[rowsb]/matrix[rowsb][rowsb]}));
-
- ForEach(i,(rowsb-1) .. 1 )[
- s:=b[i];
- ForEach(j,i+1 .. rowsb )[
- s:= s - matrix[i][j]*x[j];
- ];
- x[i]:= s/matrix[i][i];
- If(InVerboseMode(),Echo({"set x[",i,"] = ",s/matrix[i][i]}));
- ];
- x;
-];
-
-// Forward Substitution
-15 # MatrixSolve(matrix_IsLowerTriangular,b_IsVector) <--
-[
- Local(rowsm,rowsb,x,s);
- rowsm:=Length(matrix);
- rowsb:=Length(b);
- Check(rowsm=rowsb,"MatrixSolve: Matrix and vector must have same number of rows");
- x:=ZeroVector(rowsb);
-
- x[1]:=b[1]/matrix[1][1];
- If(InVerboseMode(),Echo({"set x[1] = ",b[1]/matrix[1][1]}));
-
- ForEach(i,2 .. rowsb )[
- s:=b[i];
- ForEach(j,1 .. (i-1) )[
- s:= s - matrix[i][j]*x[j];
- ];
- x[i]:= s/matrix[i][i];
- If(InVerboseMode(),Echo({"set x[",i,"] = ",s/matrix[i][i]}));
- ];
- x;
-];
-// Gaussian Elimination and Back Substitution
-// pivoting not implemented yet
-20 # MatrixSolve(matrix_IsMatrix,b_IsVector) <--
-[
- Local(aug,rowsm,rowsb,x,s);
- rowsm:=Length(matrix);
- rowsb:=Length(b);
- Check(rowsm=rowsb,"MatrixSolve: Matrix and vector must have same number of rows");
- aug:=ZeroMatrix(rowsb,rowsb+1);
- x:=ZeroVector(rowsb);
-
- // create augmented matrix
- ForEach(i, 1 .. rowsb )
- ForEach(j, 1 .. rowsb )
- aug[i][j] := matrix[i][j];
- ForEach(i, 1 .. rowsb )
- aug[i][rowsb+1] := b[i];
-
- // gaussian elimination
- ForEach(i, 1 .. (rowsb-1) )[
- // If our pivot element is 0 we need to switch
- // this row with a row that has a nonzero element
- If(aug[i][i] = 0, [
- Local(p,tmp);
- p:=i+1;
- While( aug[p][p] = 0 )[ p++; ];
- If(InVerboseMode(), Echo({"switching row ",i,"with ",p}) );
- tmp:=aug[i];
- aug[i]:=aug[p];
- aug[p]:=tmp;
- ]);
-
-
- ForEach(k, (i+1) .. rowsb )[
- s:=aug[k][i];
- ForEach(j, i .. (rowsb+1) )[
- aug[k][j] := aug[k][j] - (s/aug[i][i])*aug[i][j];
- //Echo({"aug[",k,"][",j,"] =", aug[k][j]," - ",
- // aug[k][i],"/",aug[i][i],"*",aug[i][j]," k i =", k,i });
- ];
- ];
- ];
- //PrettyForm(aug);
- x[rowsb]:=aug[rowsb][rowsb+1]/aug[rowsb][rowsb];
- If(InVerboseMode(),Echo({"set x[",rowsb,"] = ",x[rowsb] }));
-
- ForEach(i,(rowsb-1) .. 1 )[
- s:=aug[i][rowsb+1];
- ForEach(j,i+1 .. rowsb)[
- s := s - aug[i][j]*x[j];
- ];
- x[i]:=s/aug[i][i];
- If(InVerboseMode(),Echo({"set x[",i,"] = ",x[i] }));
- ];
- x;
-
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MatrixSolve",categories="User Functions;Solvers (Symbolic)"
-*CMD MatrixSolve --- solve a system of equations
-*STD
-*CALL
- MatrixSolve(A,b)
-
-*PARMS
-
-{A} -- coefficient matrix
-
-{b} -- row vector
-
-*DESC
-
-{MatrixSolve} solves the matrix equations {A*x = b} using Gaussian Elimination
-with Backward substitution. If your matrix is triangular or diagonal, it will
-be recognized as such and a faster algorithm will be used.
-
-*E.G.
-
- In> A:={{2,4,-2,-2},{1,2,4,-3},{-3,-3,8,-2},{-1,1,6,-3}};
- Out> {{2,4,-2,-2},{1,2,4,-3},{-3,-3,8,-2},{-1,1,6,-3}};
- In> b:={-4,5,7,7};
- Out> {-4,5,7,7};
- In> MatrixSolve(A,b);
- Out> {1,2,3,4};
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Minor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Minor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Minor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Minor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def="Minor"
-
-Minor(matrix,i,j) := CoFactor(matrix,i,j)*(-1)^(i+j);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Minor",categories="User Functions;Linear Algebra"
-*CMD Minor --- get principal minor of a matrix
-*STD
-*CALL
- Minor(M,i,j)
-
-*PARMS
-
-{M} -- a matrix
-
-{i}, {j} - positive integers
-
-*DESC
-
-Minor returns the minor of a matrix around
-the element ($i$, $j$). The minor is the determinant of the matrix obtained from $M$ by
-deleting the $i$-th row and the $j$-th column.
-
-*E.G.
-
- In> A := {{1,2,3}, {4,5,6}, {7,8,9}};
- Out> {{1,2,3},{4,5,6},{7,8,9}};
- In> PrettyForm(A);
-
- / \
- | ( 1 ) ( 2 ) ( 3 ) |
- | |
- | ( 4 ) ( 5 ) ( 6 ) |
- | |
- | ( 7 ) ( 8 ) ( 9 ) |
- \ /
- Out> True;
- In> Minor(A,1,2);
- Out> -6;
- In> Determinant({{2,3}, {8,9}});
- Out> -6;
-
-*SEE CoFactor, Determinant, Inverse
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Normalize.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Normalize.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Normalize.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Normalize.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="Normalize"
-
-Function("Normalize",{vector})
-[
- Local(norm);
- norm:=0;
- ForEach(item,vector)
- [
- norm:=norm+item*item;
- ];
- (1/(norm^(1/2)))*vector;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Normalize",categories="User Functions;Linear Algebra"
-*CMD Normalize --- normalize a vector
-*STD
-*CALL
- Normalize(v)
-
-*PARMS
-
-{v} -- a vector
-
-*DESC
-
-Return the normalized (unit) vector parallel to {v}: a vector having the same
-direction but with length 1.
-
-*E.G.
-
- In> v:=Normalize({3,4})
- Out> {3/5,4/5};
- In> v . v
- Out> 1;
-
-*SEE InProduct, CrossProduct
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Norm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Norm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Norm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Norm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="Norm"
-
-10 # Norm(_v) <-- PNorm(v,2);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/o_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/o_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/o_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/o_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-%mathpiper,def="o"
-
-_x o _y <-- Outer(x,y);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="o",categories="Operators"
-*CMD o --- get outer tensor product
-*STD
-*CALL
- t1 o t2
-Precedence:
-*EVAL OpPrecedence("o")
-
-*PARMS
-
-{t1,t2} -- tensor lists (currently only vectors are supported)
-
-*DESC
-
-See the {Outer} function for more information.
-
-*SEE Outer
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/OrthogonalBasis.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/OrthogonalBasis.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/OrthogonalBasis.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/OrthogonalBasis.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-%mathpiper,def="OrthogonalBasis"
-
-// This is the standard textbook definition of the Gram-Schmidt
-// Orthogonalization process, from:
-// Friedberg,Insel,Spence "Linear Algebra" (1997)
-// TODO: This function does not check if the input vectors are LI, it
-// only checks for zero vectors
-Function("OrthogonalBasis",{W})[
- Local(V,j,k);
-
- V:=ZeroMatrix(Length(W),Length(W[1]) );
-
- V[1]:=W[1];
- For(k:=2,k<=Length(W),k++)[
- Check(Not IsZero(Norm(W[k])) ,
- "OrthogonalBasis: Input vectors must be linearly independent");
- V[k]:=W[k]-Sum(j,1,k-1,InProduct(W[k],V[j])*V[j]/Norm(V[j])^2);
- ];
- V;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="OrthogonalBasis",categories="User Functions;Linear Algebra"
-*CMD OrthogonalBasis --- create an orthogonal basis
-*STD
-*CALL
- OrthogonalBasis(W)
-
-*PARMS
-
-{W} - A linearly independent set of row vectors (aka a matrix)
-
-*DESC
-
-Given a linearly independent set {W} (constructed of rows vectors),
-this command returns an orthogonal basis {V} for {W}, which means
-that span(V) = span(W) and {InProduct(V[i],V[j]) = 0} when {i != j}.
-This function uses the Gram-Schmidt orthogonalization process.
-
-*E.G.
-
- In> OrthogonalBasis({{1,1,0},{2,0,1},{2,2,1}})
- Out> {{1,1,0},{1,-1,1},{-1/3,1/3,2/3}};
-
-
-*SEE OrthonormalBasis, InProduct
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/OrthonormalBasis.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/OrthonormalBasis.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/OrthonormalBasis.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/OrthonormalBasis.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="OrthonormalBasis"
-
-// Like orthogonalization, only normalize all vectors
-Function("OrthonormalBasis",{W})[
- Local(i);
- W:=OrthogonalBasis(W);
- For(i:=1,i<=Length(W),i++)[
- W[i]:=W[i]/Norm(W[i]);
- ];
- W;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="OrthonormalBasis",categories="User Functions;Linear Algebra"
-*CMD OrthonormalBasis --- create an orthonormal basis
-*STD
-*CALL
- OrthonormalBasis(W)
-
-*PARMS
-
-{W} - A linearly independent set of row vectors (aka a matrix)
-
-*DESC
-
-Given a linearly independent set {W} (constructed of rows vectors),
-this command returns an orthonormal basis {V} for {W}. This is done
-by first using {OrthogonalBasis(W)}, then dividing each vector by its
-magnitude, so as the give them unit length.
-
-*E.G.
-
- In> OrthonormalBasis({{1,1,0},{2,0,1},{2,2,1}})
- Out> {{Sqrt(1/2),Sqrt(1/2),0},{Sqrt(1/3),-Sqrt(1/3),Sqrt(1/3)},
- {-Sqrt(1/6),Sqrt(1/6),Sqrt(2/3)}};
-
-*SEE OrthogonalBasis, InProduct, Normalize
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Outer.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Outer.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Outer.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Outer.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="Outer"
-
-// outer product of vectors
-Outer(t1_IsVector, t2_IsVector) <--
-[
- Local(i,j,n,m,result);
- n:=Length(t1);
- m:=Length(t2);
- result:=ZeroMatrix(n,m);
- For(i:=1,i<=n,i++)
- For(j:=1,j<=m,j++)
- result[i][j]:=t1[i]*t2[j];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Outer",categories="User Functions;Linear Algebra"
-*CMD Outer, o --- get outer tensor product
-*STD
-*CALL
- Outer(t1,t2)
- t1 o t2
-Precedence:
-*EVAL OpPrecedence("o")
-
-*PARMS
-
-{t1,t2} -- tensor lists (currently only vectors are supported)
-
-*DESC
-
-{Outer} returns the outer product of two tensors t1 and t2. Currently
-{Outer} work works only for vectors, i.e. tensors of rank 1. The outer
-product of two vectors yields a matrix.
-
-*E.G.
-
- In> Outer({1,2},{3,4,5})
- Out> {{3,4,5},{6,8,10}};
- In> Outer({a,b},{c,d})
- Out> {{a*c,a*d},{b*c,b*d}};
-
- Or, using the "o"-Operator:
-
- In> {1,2} o {3,4,5}
- Out> {{3,4,5},{6,8,10}};
- In> {a,b} o {c,d}
- Out> {{a*c,a*d},{b*c,b*d}};
-
-
-*SEE Dot, Cross
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/period_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/period_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/period_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/period_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,31 +0,0 @@
-%mathpiper,def="."
-
-//////
-// dot product for vectors and matrices (dr)
-//////
-
-_x . _y <-- Dot(x,y);
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name=".",categories="Operators"
-*CMD . --- get dot product of tensors
-*STD
-*CALL
- t1 . t2
-Precedence:
-*EVAL OpPrecedence(".")
-
-*PARMS
-
-{t1,t2} -- tensor lists (currently only vectors and matrices are supported)
-
-*DESC
-
-See the {Dot} function for more information.
-
-*SEE Dot
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/PNorm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/PNorm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/PNorm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/PNorm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,18 +0,0 @@
-%mathpiper,def="PNorm"
-
-// p-norm, reduces to euclidean norm when p = 2
-Function("PNorm",{v,p})
-[
- Local(result,i);
- Check(p>=1,"PNorm: p must be >= 1");
-
- result:=0;
- For(i:=1,i<=Length(v),i++)[
- result:=result+Abs(v[i])^p;
- ];
-
- // make it look nicer when p = 2
- If(p=2,Sqrt(result),(result)^(1/p) );
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/RecursiveDeterminant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/RecursiveDeterminant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/RecursiveDeterminant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/RecursiveDeterminant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-%mathpiper,def="RecursiveDeterminant",scope="private"
-
-/* Recursive calculation of determinant, provided by Sebastian Ferraro
- */
-20 # RecursiveDeterminant(_matrix) <--
-[
- /*
- Computes a determinant recursively by summing the product of each (nonzero) element on the first row of the matrix
- by +/- the determinant of the submatrix with the corresponding row and column deleted.
- */
- Local(result);
- If(Equals(Length(matrix),1),matrix[1][1],[
- result:=0;
- ForEach(i,1 .. Length(matrix))
- //Consider only non-zero entries
- If(Not(Equals(matrix[1][i],0)),
- //Transpose and Drop eliminate row 1, column i
- result:=result+matrix[1][i]*(-1)^(i+1)* RecursiveDeterminant(Transpose(Drop(Transpose(Drop(matrix,{1,1})),{i,i}))));
- result;
- ]);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Sparsity.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Sparsity.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Sparsity.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Sparsity.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-%mathpiper,def="Sparsity"
-
-Function("Sparsity",{matrix})
-[
- Local(rows,cols,nonzero);
- nonzero:=0;
- rows:=Length(matrix);
- cols:=Length(matrix[1]);
- ForEach(i, 1 .. rows )
- ForEach(j, 1 .. cols )
- If(matrix[i][j] != 0, nonzero:=nonzero+1 );
-
- N(1 - nonzero/(rows*cols));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Sparsity",categories="User Functions;Linear Algebra"
-*CMD Sparsity --- get the sparsity of a matrix
-*STD
-*CALL
- Sparsity(matrix)
-*PARMS
-
-{matrix} -- a matrix
-
-*DESC
-
-The function {Sparsity} returns a number between {0} and {1} which
-represents the percentage of zero entries in the matrix. Although
-there is no definite critical value, a sparsity of {0.75} or more
-is almost universally considered a "sparse" matrix. These type of
-matrices can be handled in a different manner than "full" matrices
-which speedup many calculations by orders of magnitude.
-
-*E.G.
-
- In> Sparsity(Identity(2))
- Out> 0.5;
- In> Sparsity(Identity(10))
- Out> 0.9;
- In> Sparsity(HankelMatrix(10))
- Out> 0.45;
- In> Sparsity(HankelMatrix(100))
- Out> 0.495;
- In> Sparsity(HilbertMatrix(10))
- Out> 0;
- In> Sparsity(ZeroMatrix(10,10))
- Out> 1;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/SylvesterMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/SylvesterMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/SylvesterMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/SylvesterMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,89 +0,0 @@
-%mathpiper,def="SylvesterMatrix"
-
-/* SylvesterMatrix */
-
-Function("SylvesterMatrix",{poly1, poly2, var})
-[
- Local(i,m,p,q,y,z,result);
- y:=Degree(poly1,var);
- z:=Degree(poly2,var);
- m:=y+z;
- p:={};
- q:={};
- result:=ZeroMatrix(m,m);
-
- For(i:=y,i>=0,i--)
- DestructiveAppend(p,Coef(poly1,var,i));
- For(i:=z,i>=0,i--)
- DestructiveAppend(q,Coef(poly2,var,i));
-
- For(i:=1,i<=z,i++)
- [
- Local(j,k);
- k:=1;
- For(j:=i,k<=Length(p),j++)
- [
- result[i][j]:=p[k];
- k++;
- ];
- ];
-
- For(i:=1,i<=y,i++)
- [
- Local(j,k);
- k:=1;
- For(j:=i,k<=Length(q),j++)
- [
- result[i+z][j]:=q[k];
- k++;
- ];
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="SylvesterMatrix",categories="User Functions;Matrices (Special)"
-*CMD SylvesterMatrix --- calculate the Sylvester matrix of two polynomials
-*STD
-*CALL
- SylvesterMatrix(poly1,poly2,variable)
-
-*PARMS
-
-{poly1} -- polynomial
-
-{poly2} -- polynomial
-
-{variable} -- variable to express the matrix for
-
-*DESC
-
-The function {SylvesterMatrix} calculates the Sylvester matrix
-for a pair of polynomials.
-
-The Sylvester matrix is closely related to the resultant, which
-is defined as the determinant of the Sylvester matrix. Two polynomials
-share common roots only if the resultant is zero.
-
-*E.G.
-
- In> ex1:= x^2+2*x-a
- Out> x^2+2*x-a;
- In> ex2:= x^2+a*x-4
- Out> x^2+a*x-4;
- In> A:=SylvesterMatrix(ex1,ex2,x)
- Out> {{1,2,-a,0},{0,1,2,-a},
- {1,a,-4,0},{0,1,a,-4}};
- In> B:=Determinant(A)
- Out> 16-a^2*a- -8*a-4*a+a^2- -2*a^2-16-4*a;
- In> Simplify(B)
- Out> 3*a^2-a^3;
-
-The above example shows that the two polynomials have common
-zeros if $ a = 3 $.
-
-*SEE Determinant, Simplify, Solve, PSolve
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/SymbolicDeterminant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/SymbolicDeterminant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/SymbolicDeterminant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/SymbolicDeterminant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-%mathpiper,def="SymbolicDeterminant",scope="private"
-
-20 # SymbolicDeterminant(_matrix) <--
-[
- Local(perms,indices,result);
- Check((IsMatrix(matrix)),"Determinant: Argument must be a matrix");
- indices:=Table(i,i,1,Length(matrix),1);
- perms:=PermutationsList(indices);
- result:=0;
- ForEach(item,perms)
- result:=result+Product(i,1,Length(matrix),matrix[i][item[i] ])*
- LeviCivita(item);
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ToeplitzMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ToeplitzMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ToeplitzMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ToeplitzMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,40 +0,0 @@
-%mathpiper,def="ToeplitzMatrix"
-
-// The arguments of the following functions should be checked
-ToeplitzMatrix(N):=GenMatrix({{i,j},N[Abs(i-j)+1]}, Length(N), Length(N) );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ToeplitzMatrix",categories="User Functions;Matrices (Special)"
-*CMD ToeplitzMatrix --- create a Toeplitz matrix
-*STD
-*CALL
- ToeplitzMatrix(N)
-*PARMS
-
-{N} -- an $n$-dimensional row vector
-
-*DESC
-
-The function {ToeplitzMatrix} calculates the Toeplitz matrix given
-an $n$-dimensional row vector. This matrix has the same entries in
-all diagonal columns, from upper left to lower right.
-
-*E.G.
-
- In> PrettyForm(ToeplitzMatrix({1,2,3,4,5}))
-
- / \
- | ( 1 ) ( 2 ) ( 3 ) ( 4 ) ( 5 ) |
- | |
- | ( 2 ) ( 1 ) ( 2 ) ( 3 ) ( 4 ) |
- | |
- | ( 3 ) ( 2 ) ( 1 ) ( 2 ) ( 3 ) |
- | |
- | ( 4 ) ( 3 ) ( 2 ) ( 1 ) ( 2 ) |
- | |
- | ( 5 ) ( 4 ) ( 3 ) ( 2 ) ( 1 ) |
- \ /
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Trace.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Trace.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Trace.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Trace.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,30 +0,0 @@
-%mathpiper,def="Trace"
-
-Trace(matrix_IsList) <-- Tr(matrix);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Trace",categories="User Functions;Linear Algebra"
-*CMD Trace --- trace of a matrix
-*STD
-*CALL
- Trace(M)
-
-*PARMS
-
-{M} -- a matrix
-
-*DESC
-
-{Trace} returns the trace of a matrix $M$ (defined as the sum of the
-elements on the diagonal of the matrix).
-
-*E.G.
-
- In> A:=DiagonalMatrix(1 .. 4)
- Out> {{1,0,0,0},{0,2,0,0},{0,0,3,0},{0,0,0,4}};
- In> Trace(A)
- Out> 10;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Transpose.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Transpose.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Transpose.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Transpose.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="Transpose"
-
-Transpose(matrix_IsList)_(Length(Dimensions(matrix))>1) <--
-[
- Local(i,j,result);
- result:=ZeroMatrix(Length(matrix[1]),Length(matrix));
- For(i:=1,i<=Length(matrix),i++)
- For(j:=1,j<=Length(matrix[1]),j++)
- result[j][i]:=matrix[i][j];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Transpose",categories="User Functions;Linear Algebra"
-*CMD Transpose --- get transpose of a matrix
-*STD
-*CALL
- Transpose(M)
-
-*PARMS
-
-{M} -- a matrix
-
-*DESC
-
-{Transpose} returns the transpose of a matrix $M$. Because matrices are
-just lists of lists, this is a useful operation too for lists.
-
-*E.G.
-
- In> Transpose({{a,b}})
- Out> {{a},{b}};
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Tr.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Tr.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/Tr.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/Tr.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-%mathpiper,def="Tr"
-
-Tr(x_IsList) <--
-[
- Local(i,j,n,d,r,aux,result);
- d:=Dimensions(x);
- r:=Length(d); // tensor rank
- n:=Min(d); // minimal dim
- result:=0;
- For(i:=1,i<=n,i++)
- [
- aux:=x[i];
- For(j:=2,j<=r,j++)
- aux:=aux[i];
- result:=result+aux;
- ];
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/VandermondeMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/VandermondeMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/VandermondeMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/VandermondeMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="VandermondeMatrix"
-
-Function("VandermondeMatrix",{vector})[
- Local(len,i,j,item,matrix);
- len:=Length(vector);
- matrix:=ZeroMatrix(len,len);
-
- For(i:=1,i<=Length(matrix),i++)[
- For(j:=1,j<=Length(matrix[1]),j++)[
- matrix[j][i]:=vector[i]^(j-1);
- ];
- ];
-
- matrix;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="VandermondeMatrix",categories="User Functions;Matrices (Special)"
-*CMD VandermondeMatrix --- create the Vandermonde matrix
-*STD
-*CALL
- VandermondeMatrix(vector)
-*PARMS
-
-{vector} -- an $n$-dimensional vector
-
-*DESC
-
-The function {VandermondeMatrix} calculates the Vandermonde matrix
-of a vector.
-
-The ($i$,$j$)-th element of the Vandermonde matrix is defined as $i^(j-1)$.
-
-*E.G.
- In> VandermondeMatrix({1,2,3,4})
- Out> {{1,1,1,1},{1,2,3,4},{1,4,9,16},{1,8,27,64}};
- In>PrettyForm(%)
-
- / \
- | ( 1 ) ( 1 ) ( 1 ) ( 1 ) |
- | |
- | ( 1 ) ( 2 ) ( 3 ) ( 4 ) |
- | |
- | ( 1 ) ( 4 ) ( 9 ) ( 16 ) |
- | |
- | ( 1 ) ( 8 ) ( 27 ) ( 64 ) |
- \ /
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/WilkinsonMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/WilkinsonMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/WilkinsonMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/WilkinsonMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,13 +0,0 @@
-%mathpiper,def="WilkinsonMatrix",scope="private"
-
-// Used to test numerical eigenvalue algorithms, because it
-// has eigenvalues extremely close to each other.
-// WilkinsonMatrix(21) has 2 eigenvalues near 10.7 that agree
-// to 14 decimal places
-// Leto: I am not going to document this until we actually have
-// numerical eigenvalue algorithms
-WilkinsonMatrix(N):=GenMatrix({{i,j},
- If( Abs(i-j)=1,1,
- [ If(i=j,Abs( (N-1)/2 - i+1 ),0 ); ] )}, N,N );
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/WronskianMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/WronskianMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/WronskianMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/WronskianMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,60 +0,0 @@
-%mathpiper,def="WronskianMatrix"
-
-// The arguments of the following functions should be checked
-// this takes N funcs in 1 var
-WronskianMatrix(f,v):=GenMatrix({{i,j}, Deriv(v,i-1) f[j]}, Length(f), Length(f) );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="WronskianMatrix",categories="User Functions;Matrices (Special)"
-*CMD WronskianMatrix --- create the Wronskian matrix
-*STD
-*CALL
- WronskianMatrix(func,var)
-*PARMS
-
-{func} -- an $n$-dimensional vector of functions
-
-{var} -- a variable to differentiate with respect to
-
-*DESC
-
-The function {WronskianMatrix} calculates the Wronskian matrix
-of $n$ functions.
-
-The Wronskian matrix is created by putting each function as the
-first element of each column, and filling in the rest of each
-column by the ($i-1$)-th derivative, where $i$ is the current row.
-
-The Wronskian matrix is used to verify that the $n$ functions are linearly
-independent, usually solutions to a differential equation.
-If the determinant of the Wronskian matrix is zero, then the functions
-are dependent, otherwise they are independent.
-
-*E.G.
- In> WronskianMatrix({Sin(x),Cos(x),x^4},x);
- Out> {{Sin(x),Cos(x),x^4},{Cos(x),-Sin(x),4*x^3},
- {-Sin(x),-Cos(x),12*x^2}};
- In> PrettyForm(%)
-
- / \
- | ( Sin( x ) ) ( Cos( x ) ) / 4 \ |
- | \ x / |
- | |
- | ( Cos( x ) ) ( -( Sin( x ) ) ) / 3 \ |
- | \ 4 * x / |
- | |
- | ( -( Sin( x ) ) ) ( -( Cos( x ) ) ) / 2 \ |
- | \ 12 * x / |
- \ /
-The last element is a linear combination of the first two, so the determinant is zero:
- In> A:=Determinant( WronskianMatrix( {x^4,x^3,2*x^4
- + 3*x^3},x ) )
- Out> x^4*3*x^2*(24*x^2+18*x)-x^4*(8*x^3+9*x^2)*6*x
- +(2*x^4+3*x^3)*4*x^3*6*x-4*x^6*(24*x^2+18*x)+x^3
- *(8*x^3+9*x^2)*12*x^2-(2*x^4+3*x^3)*3*x^2*12*x^2;
- In> Simplify(A)
- Out> 0;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/X_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/X_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/X_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/X_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="X"
-
-x X y := CrossProduct(x,y);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ZeroMatrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ZeroMatrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ZeroMatrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ZeroMatrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="ZeroMatrix"
-
-5 # ZeroMatrix(n_IsNonNegativeInteger) <-- ZeroMatrix(n,n);
-
-10 # ZeroMatrix(n_IsNonNegativeInteger,m_IsNonNegativeInteger) <--
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=n,i++)
- DestructiveInsert(result,i,ZeroVector(m));
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ZeroMatrix",categories="User Functions;Linear Algebra"
-*CMD ZeroMatrix --- make a zero matrix
-*STD
-*CALL
- ZeroMatrix(n)
- ZeroMatrix(n, m)
-
-*PARMS
-
-{n} -- number of rows
-
-{m} -- number of columns
-
-*DESC
-
-This command returns a matrix with {n} rows and {m} columns,
-completely filled with zeroes. If only given one parameter,
-it returns the square {n} by {n} zero matrix.
-
-*E.G.
-
- In> ZeroMatrix(3,4)
- Out> {{0,0,0,0},{0,0,0,0},{0,0,0,0}};
- In> ZeroMatrix(3)
- Out> {{0,0,0},{0,0,0},{0,0,0}};
-
-
-*SEE ZeroVector, Identity
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ZeroVector.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ZeroVector.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/linalg/ZeroVector.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/linalg/ZeroVector.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-%mathpiper,def="ZeroVector"
-
-Function("ZeroVector",{n})
-[
- Local(i,result);
- result:={};
- For(i:=1,i<=n,i++)
- [
- DestructiveInsert(result,1,0);
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ZeroVector",categories="User Functions;Linear Algebra"
-*CMD ZeroVector --- create a vector with all zeroes
-*STD
-*CALL
- ZeroVector(n)
-
-*PARMS
-
-{n} -- length of the vector to return
-
-*DESC
-
-This command returns a vector of length "n", filled with zeroes.
-
-*E.G.
-
- In> ZeroVector(4)
- Out> {0,0,0,0};
-
-*SEE BaseVector, ZeroMatrix, IsZeroVector
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Append.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Append.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Append.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Append.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="Append"
-
-Function("Append",{list,element})
-[
- Check(IsList(list), "The first argument must be a list.");
-
- Insert(list,Length(list)+1,element);
-];
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Append",categories="User Functions;Lists (Operations)"
-*CMD Append --- append an entry at the end of a list
-*STD
-*CALL
- Append(list, expr)
-
-*PARMS
-
-{list} -- list to append "expr" to
-
-{expr} -- expression to append to the list
-
-*DESC
-
-The expression "expr" is appended at the end of "list" and the
-resulting list is returned.
-
-Note that due to the underlying data structure, the time it takes to
-append an entry at the end of a list grows linearly with the length of
-the list, while the time for prepending an entry at the beginning is
-constant.
-
-*E.G.
-
- In> Append({a,b,c,d}, 1);
- Out> {a,b,c,d,1};
-
-*SEE Concat, :, DestructiveAppend
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/BSearch.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/BSearch.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/BSearch.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/BSearch.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-%mathpiper,def="BSearch"
-
-LocalSymbols(max,f,result)
-[
- BSearch(max,f) :=
- [
- Local(result);
- Set(result, FindIsq(max,f));
- If(Apply(f,{result})!=0,Set(result,-1));
- result;
- ];
-];
-UnFence("BSearch",2);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/BubbleSort.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/BubbleSort.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/BubbleSort.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/BubbleSort.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,68 +0,0 @@
-%mathpiper,def="BubbleSort"
-
-Function("BubbleSort",{list,compare})
-[
- Local(i,j,length,left,right);
-
- list:=FlatCopy(list);
- length:=Length(list);
-
- For (j:=length,j>1,j--)
- [
- For(i:=1,i BubbleSort({4,7,23,53,-2,1}, "<");
- Out> {-2,1,4,7,23,53};
- In> HeapSort({4,7,23,53,-2,1}, ">");
- Out> {53,23,7,4,1,-2};
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Contains.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Contains.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Contains.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Contains.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-%mathpiper,def="Contains"
-
-Function("Contains",{list,element})
-[
- Local(result);
- Set(result,False);
- While(And(Not(result), Not(Equals(list, {}))))
- [
- If(Equals(First(list),element),
- Set(result, True),
- Set(list, Rest(list))
- );
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Contains",categories="User Functions;Lists (Operations)"
-*CMD Contains --- test whether a list contains a certain element
-*STD
-*CALL
- Contains(list, expr)
-
-*PARMS
-
-{list} -- list to examine
-
-{expr} -- expression to look for in "list"
-
-*DESC
-
-This command tests whether "list" contains the expression "expr"
-as an entry. It returns {True} if it does and
-{False} otherwise. Only the top level of "list" is
-examined. The parameter "list" may also be a general expression, in
-that case the top-level operands are tested for the occurrence of
-"expr".
-
-*E.G.
-
- In> Contains({a,b,c,d}, b);
- Out> True;
- In> Contains({a,b,c,d}, x);
- Out> False;
- In> Contains({a,{1,2,3},z}, 1);
- Out> False;
- In> Contains(a*b, b);
- Out> True;
-
-*SEE Find, Count
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Count.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Count.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Count.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Count.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="Count"
-
-Function("Count",{list,element})
-[
- Local(result);
- Set(result,0);
- ForEach(item,list) If(Equals(item, element), Set(result,AddN(result,1)));
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Count",categories="User Functions;Lists (Operations)"
-*CMD Count --- count the number of occurrences of an expression
-*STD
-*CALL
- Count(list, expr)
-
-*PARMS
-
-{list} -- the list to examine
-
-{expr} -- expression to look for in "list"
-
-*DESC
-
-This command counts the number of times that the expression "expr"
-occurs in "list" and returns this number.
-
-*E.G.
-
- In> lst := {a,b,c,b,a};
- Out> {a,b,c,b,a};
- In> Count(lst, a);
- Out> 2;
- In> Count(lst, c);
- Out> 1;
- In> Count(lst, x);
- Out> 0;
-
-*SEE Length, Select, Contains
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/DestructiveAppendList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/DestructiveAppendList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/DestructiveAppendList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/DestructiveAppendList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,14 +0,0 @@
-%mathpiper,def="DestructiveAppendList"
-
-Function("DestructiveAppendList",{list,toadd})
-[
- Local(i,nr);
- nr:=Length(toadd);
- For(i:=1,i<=nr,i++)
- [
- DestructiveAppend(list,toadd[i]);
- ];
- True;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/DestructiveAppend.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/DestructiveAppend.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/DestructiveAppend.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/DestructiveAppend.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-%mathpiper,def="DestructiveAppend"
-
-Function("DestructiveAppend",{list,element})
-[
- DestructiveInsert(list,Length(list)+1,element);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="DestructiveAppend",categories="User Functions;Lists (Operations)"
-*CMD DestructiveAppend --- destructively append an entry to a list
-*STD
-*CALL
- DestructiveAppend(list, expr)
-
-*PARMS
-
-{list} -- list to append "expr" to
-
-{expr} -- expression to append to the list
-
-*DESC
-
-This is the destructive counterpart of {Append}. This
-command yields the same result as the corresponding call to
-{Append}, but the original list is modified. So if a
-variable is bound to "list", it will now be bound to the list with
-the expression "expr" inserted.
-
-Destructive commands run faster than their nondestructive counterparts
-because the latter copy the list before they alter it.
-
-*E.G.
-
- In> lst := {a,b,c,d};
- Out> {a,b,c,d};
- In> Append(lst, 1);
- Out> {a,b,c,d,1};
- In> lst
- Out> {a,b,c,d};
- In> DestructiveAppend(lst, 1);
- Out> {a,b,c,d,1};
- In> lst;
- Out> {a,b,c,d,1};
-
-*SEE Concat, :, Append
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Difference.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Difference.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Difference.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Difference.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-%mathpiper,def="Difference"
-
-Function("Difference",{list1,list2})
-[
- Local(l2,index,result);
- l2:=FlatCopy(list2);
- result:=FlatCopy(list1);
- ForEach(item,list1)
- [
- Set(index,Find(l2,item));
- If(index>0,
- [
- DestructiveDelete(l2,index);
- DestructiveDelete(result,Find(result,item));
- ]
- );
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Difference",categories="User Functions;Lists (Operations)"
-*CMD Difference --- return the difference of two lists
-*STD
-*CALL
- Difference(l1, l2)
-
-*PARMS
-
-{l1}, {l2} -- two lists
-
-*DESC
-
-The difference of the lists "l1" and "l2" is determined and
-returned. The difference contains all elements that occur in "l1"
-but not in "l2". The order of elements in "l1" is preserved. If a
-certain expression occurs "n1" times in the first list and "n2"
-times in the second list, it will occur "n1-n2" times in the result
-if "n1" is greater than "n2" and not at all otherwise.
-
-*E.G.
-
- In> Difference({a,b,c}, {b,c,d});
- Out> {a};
- In> Difference({a,e,i,o,u}, {f,o,u,r,t,e,e,n});
- Out> {a,i};
- In> Difference({1,2,2,3,3,3}, {2,2,3,4,4});
- Out> {1,3,3};
-
-*SEE Intersection, Union
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Drop.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Drop.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Drop.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Drop.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,64 +0,0 @@
-%mathpiper,def="Drop"
-
-/* ���� Drop ���� */
-
-/* Needs to check the parameters */
-
-/*
- * Drop( list, n ) gives 'list' with its first n elements dropped
- * Drop( list, -n ) gives 'list' with its last n elements dropped
- * Drop( list, {m,n} ) gives 'list' with elements m through n dropped
- */
-
-RuleBase("Drop", {lst, range});
-
-Rule("Drop", 2, 1, IsList(range))
- Concat(Take(lst,range[1]-1), Drop(lst, range[2]));
-
-Rule("Drop", 2, 2, range >= 0)
- If( range = 0 Or lst = {}, lst, Drop( Rest(lst), range-1 ));
-
-Rule("Drop", 2, 2, range < 0)
- Take( lst, Length(lst) + range );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Drop",categories="User Functions;Lists (Operations)"
-*CMD Drop --- drop a range of elements from a list
-
-*STD
-
-*CALL
- Drop(list, n)
- Drop(list, -n)
- Drop(list, {m,n})
-
-*PARMS
-
-{list} -- list to act on
-
-{n}, {m} -- positive integers describing the entries to drop
-
-*DESC
-
-This command removes a sublist of "list" and returns a list
-containing the remaining entries. The first calling sequence drops the
-first "n" entries in "list". The second form drops the last "n"
-entries. The last invocation drops the elements with indices "m"
-through "n".
-
-*E.G.
-
- In> lst := {a,b,c,d,e,f,g};
- Out> {a,b,c,d,e,f,g};
- In> Drop(lst, 2);
- Out> {c,d,e,f,g};
- In> Drop(lst, -3);
- Out> {a,b,c,d};
- In> Drop(lst, {2,4});
- Out> {a,e,f,g};
-
-*SEE Take, Select, Remove
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FillList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FillList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FillList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FillList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="FillList"
-
-Function("FillList", {aItem, aLength})
-[
- Local(i, aResult);
- aResult:={};
- For(i:=0, i FillList(x, 5);
- Out> {x,x,x,x,x};
-
-*SEE MakeVector, ZeroVector, RandomIntegerVector
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FindIsq.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FindIsq.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FindIsq.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FindIsq.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,29 +0,0 @@
-%mathpiper,def="FindIsq"
-
-LocalSymbols(max,f,low,high,mid,current)
-[
-FindIsq(max,f) :=
-[
- Local(low,high,mid,current);
- low:=1;
- high:=max+1;
- Set(mid,((high+low)>>1));
- While(high>low And mid>1)
- [
- Set(mid,((high+low)>>1));
- Set(current,Apply(f,{mid}));
-//Echo({low,high,current});
- If(current = 0,
- high:=low-1,
- If(current > 0,
- Set(high,mid),
- Set(low,mid+1)
- )
- );
- ];
- mid;
-];
-];
-UnFence("FindIsq",2);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Find.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Find.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Find.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Find.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-%mathpiper,def="Find"
-
-Function("Find",{list,element})
-[
- Local(result,count);
- Set(result, -1);
- Set(count, 1);
- While(And(result<0, Not(Equals(list, {}))))
- [
- If(Equals(First(list), element),
- Set(result, count)
- );
- Set(list,Rest(list));
- Set(count,AddN(count,1));
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Find",categories="User Functions;Lists (Operations)"
-*CMD Find --- get the index at which a certain element occurs
-*STD
-*CALL
- Find(list, expr)
-
-*PARMS
-
-{list} -- the list to examine
-
-{expr} -- expression to look for in "list"
-
-*DESC
-
-This commands returns the index at which the expression "expr"
-occurs in "list". If "expr" occurs more than once, the lowest
-index is returned. If "expr" does not occur at all,
-{-1} is returned.
-
-*E.G.
-
- In> Find({a,b,c,d,e,f}, d);
- Out> 4;
- In> Find({1,2,3,2,1}, 2);
- Out> 2;
- In> Find({1,2,3,2,1}, 4);
- Out> -1;
-
-*SEE Contains
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FindPredicate.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FindPredicate.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FindPredicate.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FindPredicate.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-%mathpiper,def="FindPredicate"
-
-// Find the first thingy that matches a predicate
-Function("FindPredicate",{list,predicate})
-[
- Local(result,count);
- Set(result, -1);
- Set(count, 1);
- While(And(result<0, Not(Equals(list, {}))))
- [
- If(Apply(predicate,{First(list)}),
- Set(result, count)
- );
- Set(list,Rest(list));
- Set(count,AddN(count,1));
- ];
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncListArith.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncListArith.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncListArith.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncListArith.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="FuncListArith"
-
-/* FuncListArith() is defined to only look at arithmetic operations +, -, *, /. */
-
-FuncListArith(expr) := FuncList(expr, {Atom("+"), Atom("-"), *, /});
-
-HoldArgNr("FuncListArith", 1, 1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="FuncListArith",categories="User Functions;Lists (Operations)"
-*CMD FuncList --- list of functions used in an expression
-*CMD FuncListArith --- list of functions used in an expression
-*CMD FuncListSome --- list of functions used in an expression
-*STD
-*CALL
- FuncList(expr)
- FuncListArith(expr)
- FuncListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- list of function atoms to be considered "transparent"
-
-*DESC
-
-The command {FuncList(expr)} returns a list of all function atoms that appear
-in the expression {expr}. The expression is recursively traversed.
-
-The command {FuncListSome(expr, list)} does the same, except it only looks at arguments of a given {list} of functions. All other functions become "opaque" (as if they do not contain any other functions).
-For example, {FuncListSome(a + Sin(b-c))} will see that the expression has a "{-}" operation and return {{+,Sin,-}}, but {FuncListSome(a + Sin(b-c), {+})} will not look at arguments of {Sin()} and will return {{+,Sin}}.
-
-{FuncListArith} is defined through {FuncListSome} to look only at arithmetic operations {+}, {-}, {*}, {/}.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G. notest
-
- In> FuncList(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos,/,Ln};
- In> FuncListArith(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos};
- In> FuncListSome({a+b*2,c/d},{List})
- Out> {List,+,/};
-
-*SEE VarList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,86 +0,0 @@
-%mathpiper,def="FuncList"
-
-//////////////////////////////////////////////////
-/// FuncList --- list all function atoms used in an expression
-//////////////////////////////////////////////////
-/// like VarList except collects functions
-
-10 # FuncList(expr_IsAtom) <-- {};
-20 # FuncList(expr_IsFunction) <--
-RemoveDuplicates(
- Concat(
- {First(Listify(expr))},
- Apply("Concat",
- MapSingle("FuncList", Rest(Listify(expr)))
- )
- )
-);
-
-/*
-This is like FuncList except only looks at arguments of a given list of functions. All other functions become "opaque".
-
-*/
-10 # FuncList(expr_IsAtom, look'list_IsList) <-- {};
-// a function not in the looking list - return its type
-20 # FuncList(expr_IsFunction, look'list_IsList)_(Not Contains(look'list, Atom(Type(expr)))) <-- {Atom(Type(expr))};
-// a function in the looking list - traverse its arguments
-30 # FuncList(expr_IsFunction, look'list_IsList) <--
-RemoveDuplicates(
- Concat(
- {First(Listify(expr))},
- [ // gave up trying to do it using Map and MapSingle... so writing a loop now.
- // obtain a list of functions, considering only functions in look'list
- Local(item, result);
- result := {};
- ForEach(item, expr) result := Concat(result, FuncList(item, look'list));
- result;
- ]
- )
-);
-
-HoldArgNr("FuncList", 1, 1);
-HoldArgNr("FuncList", 2, 1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="FuncList",categories="User Functions;Lists (Operations)"
-*CMD FuncList --- list of functions used in an expression
-*CMD FuncListArith --- list of functions used in an expression
-*CMD FuncListSome --- list of functions used in an expression
-*STD
-*CALL
- FuncList(expr)
- FuncListArith(expr)
- FuncListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- list of function atoms to be considered "transparent"
-
-*DESC
-
-The command {FuncList(expr)} returns a list of all function atoms that appear
-in the expression {expr}. The expression is recursively traversed.
-
-The command {FuncListSome(expr, list)} does the same, except it only looks at arguments of a given {list} of functions. All other functions become "opaque" (as if they do not contain any other functions).
-For example, {FuncListSome(a + Sin(b-c))} will see that the expression has a "{-}" operation and return {{+,Sin,-}}, but {FuncListSome(a + Sin(b-c), {+})} will not look at arguments of {Sin()} and will return {{+,Sin}}.
-
-{FuncListArith} is defined through {FuncListSome} to look only at arithmetic operations {+}, {-}, {*}, {/}.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G. notest
-
- In> FuncList(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos,/,Ln};
- In> FuncListArith(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos};
- In> FuncListSome({a+b*2,c/d},{List})
- Out> {List,+,/};
-
-*SEE VarList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncListSome.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncListSome.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/FuncListSome.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/FuncListSome.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def=""
-
-//todo:tk:not defined in the scripts.
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="FuncListSome",categories="User Functions;Lists (Operations)"
-*CMD FuncList --- list of functions used in an expression
-*CMD FuncListArith --- list of functions used in an expression
-*CMD FuncListSome --- list of functions used in an expression
-*STD
-*CALL
- FuncList(expr)
- FuncListArith(expr)
- FuncListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- list of function atoms to be considered "transparent"
-
-*DESC
-
-The command {FuncList(expr)} returns a list of all function atoms that appear
-in the expression {expr}. The expression is recursively traversed.
-
-The command {FuncListSome(expr, list)} does the same, except it only looks at arguments of a given {list} of functions. All other functions become "opaque" (as if they do not contain any other functions).
-For example, {FuncListSome(a + Sin(b-c))} will see that the expression has a "{-}" operation and return {{+,Sin,-}}, but {FuncListSome(a + Sin(b-c), {+})} will not look at arguments of {Sin()} and will return {{+,Sin}}.
-
-{FuncListArith} is defined through {FuncListSome} to look only at arithmetic operations {+}, {-}, {*}, {/}.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G. notest
-
- In> FuncList(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos,/,Ln};
- In> FuncListArith(x+y*Cos(Ln(x)/x))
- Out> {+,*,Cos};
- In> FuncListSome({a+b*2,c/d},{List})
- Out> {List,+,/};
-
-*SEE VarList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/global_stack.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/global_stack.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/global_stack.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/global_stack.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,76 +0,0 @@
-%mathpiper,def="GlobalPush;GlobalPop"
-
-//////////////////////////////////////////////////
-/// Global stack operations on variables
-//////////////////////////////////////////////////
-
-
-LocalSymbols(GlobalStack, x)
-[
- GlobalStack := {};
-
- GlobalPop(x_IsAtom) <--
- [
- Check(Length(GlobalStack)>0, "GlobalPop: Error: empty GlobalStack");
- MacroSet(x, PopFront(GlobalStack));
- Eval(x);
- ];
-
- HoldArgNr("GlobalPop", 1, 1);
-
- GlobalPop() <--
- [
- Check(Length(GlobalStack)>0, "GlobalPop: Error: empty GlobalStack");
- PopFront(GlobalStack);
- ];
-
- GlobalPush(_x) <--
- [
- Push(GlobalStack, x);
- x;
- ];
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="GlobalPop;GlobalPush",categories="User Functions;Lists (Operations)"
-*CMD GlobalPop --- restore variables using a global stack
-*CMD GlobalPush --- save variables using a global stack
-*STD
-*CALL
- GlobalPop(var)
- GlobalPop()
- GlobalPush(expr)
-
-*PARMS
-
-{var} -- atom, name of variable to restore from the stack
-
-{expr} -- expression, value to save on the stack
-
-*DESC
-
-These functions operate with a global stack, currently implemented as a list that is not accessible externally (it is protected
-through {LocalSymbols}).
-
-{GlobalPush} stores a value on the stack. {GlobalPop} removes the last pushed value from the stack. If a variable name is given, the variable is assigned, otherwise the popped value is returned.
-
-If the global stack is empty, an error message is printed.
-
-*E.G.
-
- In> GlobalPush(3)
- Out> 3;
- In> GlobalPush(Sin(x))
- Out> Sin(x);
- In> GlobalPop(x)
- Out> Sin(x);
- In> GlobalPop(x)
- Out> 3;
- In> x
- Out> 3;
-
-*SEE Push, PopFront
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/HeapSort.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/HeapSort.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/HeapSort.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/HeapSort.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,83 +0,0 @@
-%mathpiper,def="HeapSort"
-
-HeapSort(list, compare) := HeapSort(list, ArrayCreate(Length(list), 0), 1, Length(list), compare);
-
-// this will sort "list" and mangle "tmplist"
-1 # HeapSort(_list, _tmplist, _first, _last, _compare) _ (last - first <= 2) <-- SmallSort(list, first, last, compare);
-2 # HeapSort(_list, _tmplist, _first, _last, _compare) <--
-[ // See: J. W. J. Williams, Algorithm 232 (Heapsort), Com. of ACM, vol. 7, no. 6, p. 347 (1964)
- // sort two halves recursively, then merge two halves
- // cannot merge in-place efficiently, so need a second list
- Local(mid, ileft, iright, pleft);
- mid := first+((last-first)>>1);
- HeapSort(list, tmplist, first, mid, compare);
- HeapSort(list, tmplist, mid+1, last, compare);
- // copy the lower part to temporary array
- For(ileft := first, ileft <= mid, ileft++)
- tmplist[ileft] := list[ileft];
- For(
- [ileft := first; pleft := first; iright := mid+1;],
- ileft <= mid, // if the left half is finished, we don't have to do any more work
- pleft++ // one element is stored at each iteration
- ) // merge two halves
- // elements before pleft have been stored
- // the smallest element of the right half is at iright
- // the smallest element of the left half is at ileft, access through tmplist
- If( // we copy an element from ileft either if it is smaller or if the right half is finished; it is unnecessary to copy the remainder of the right half since the right half stays in the "list"
- iright>last Or Apply(compare,{tmplist[ileft],list[iright]}),
- [ // take element from ileft
- list[pleft] := tmplist[ileft];
- ileft++;
- ],
- [ // take element from iright
- list[pleft] := list[iright];
- iright++;
- ]
- );
-
- list;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HeapSort",categories="User Functions;Lists (Operations)"
-*CMD BubbleSort --- sort a list
-*CMD HeapSort --- sort a list
-*STD
-*CALL
- BubbleSort(list, compare)
- HeapSort(list, compare)
-
-*PARMS
-
-{list} -- list to sort
-
-{compare} -- function used to compare elements of {list}
-
-*DESC
-
-This command returns {list} after it is sorted using {compare} to
-compare elements. The function {compare} should accept two arguments,
-which will be elements of {list}, and compare them. It should return
-{True} if in the sorted list the second argument
-should come after the first one, and {False}
-otherwise.
-
-The function {BubbleSort} uses the so-called "bubble sort" algorithm to do the
-sorting by swapping elements that are out of order. This algorithm is easy to
-implement, though it is not particularly fast. The sorting time is proportional
-to $n^2$ where $n$ is the length of the list.
-
-The function {HeapSort} uses a recursive algorithm "heapsort" and is much
-faster for large lists. The sorting time is proportional to $n*Ln(n)$ where $n$
-is the length of the list.
-
-*E.G.
-
- In> BubbleSort({4,7,23,53,-2,1}, "<");
- Out> {-2,1,4,7,23,53};
- In> HeapSort({4,7,23,53,-2,1}, ">");
- Out> {53,23,7,4,1,-2};
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Intersection.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Intersection.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Intersection.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Intersection.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-%mathpiper,def="Intersection"
-
-Function("Intersection",{list1,list2})
-[
- Local(l2,index,result);
- l2:=FlatCopy(list2);
- result:={};
- ForEach(item,list1)
- [
- Set(index, Find(l2,item));
- If(index>0,
- [
- DestructiveDelete(l2,index);
- DestructiveInsert(result,1,item);
- ]
- );
- ];
- DestructiveReverse(result);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Intersection",categories="User Functions;Lists (Operations)"
-*CMD Intersection --- return the intersection of two lists
-*STD
-*CALL
- Intersection(l1, l2)
-
-*PARMS
-
-{l1}, {l2} -- two lists
-
-*DESC
-
-The intersection of the lists "l1" and "l2" is determined and
-returned. The intersection contains all elements that occur in both
-lists. The entries in the result are listed in the same order as in
-"l1". If an expression occurs multiple times in both "l1" and
-"l2", then it will occur the same number of times in the result.
-
-*E.G.
-
- In> Intersection({a,b,c}, {b,c,d});
- Out> {b,c};
- In> Intersection({a,e,i,o,u}, {f,o,u,r,t,e,e,n});
- Out> {e,o,u};
- In> Intersection({1,2,2,3,3,3}, {1,1,2,2,3,3});
- Out> {1,2,2,3,3};
-
-*SEE Union, Difference
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MacroMapArgs.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MacroMapArgs.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MacroMapArgs.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MacroMapArgs.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="MacroMapArgs"
-
-/* Another Macro... hack for /: to work. */
-Macro("MacroMapArgs",{expr,oper})
-[
- Local(ex,tl,op);
- Set(op,@oper);
- Set(ex,Listify(@expr));
- Set(tl,Rest(ex));
-
- UnList(Concat({ex[1]},
- `MacroMapSingle(@op,Hold(@tl)))
- );
-];
-
-UnFence("MacroMapArgs",2);
-HoldArg("MacroMapArgs",oper);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MacroMapSingle.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MacroMapSingle.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MacroMapSingle.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MacroMapSingle.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-%mathpiper,def="MacroMapSingle"
-
-/* Another Macro... hack for /: to work. */
-TemplateFunction("MacroMapSingle",{func,list})
-[
- Local(mapsingleresult);
- mapsingleresult:={};
-
- ForEach(mapsingleitem,list)
- [
- DestructiveInsert(mapsingleresult,1,
- `ApplyPure(func,{Hold(Hold(@mapsingleitem))}));
- ];
- DestructiveReverse(mapsingleresult);
-];
-UnFence("MacroMapSingle",2);
-HoldArg("MacroMapSingle",func);
-HoldArg("MacroMapSingle",list);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MapArgs.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MapArgs.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MapArgs.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MapArgs.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="MapArgs"
-
-TemplateFunction("MapArgs",{expr,oper})
-[
- Set(expr,Listify(expr));
- UnList(Concat({expr[1]},
- Apply("MapSingle",{oper,Rest(expr)})
- ) );
-];
-UnFence("MapArgs",2);
-HoldArg("MapArgs",oper);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MapArgs",categories="User Functions;Control Flow"
-*CMD MapArgs --- apply a function to all top-level arguments
-*STD
-*CALL
- MapArgs(expr, fn)
-
-*PARMS
-
-{expr} -- an expression to work on
-
-{fn} -- an operation to perform on each argument
-
-*DESC
-
-Every top-level argument in "expr" is substituted by the result of
-applying "fn" to this argument. Here "fn" can be either the name
-of a function or a pure function (see Apply for more information on
-pure functions).
-
-*E.G.
-
- In> MapArgs(f(x,y,z),"Sin");
- Out> f(Sin(x),Sin(y),Sin(z));
- In> MapArgs({3,4,5,6}, {{x},x^2});
- Out> {9,16,25,36};
-
-*SEE MapSingle, Map, Apply
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Map.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Map.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Map.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Map.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-%mathpiper,def="Map"
-
-LocalSymbols(func,lists,mapsingleresult,mapsingleitem)
-[
- Function("Map",{func,lists})
- [
- Local(mapsingleresult,mapsingleitem);
- mapsingleresult:={};
- lists:=Transpose(lists);
- ForEach(mapsingleitem,lists)
- [
- DestructiveInsert(mapsingleresult,1,Apply(func,mapsingleitem));
- ];
- DestructiveReverse(mapsingleresult);
- ];
- UnFence("Map",2);
- HoldArg("Map",func);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Map",categories="User Functions;Lists (Operations)"
-*CMD Map --- apply an $n$-ary function to all entries in a list
-*STD
-*CALL
- Map(fn, list)
-
-*PARMS
-
-{fn} -- function to apply
-
-{list} -- list of lists of arguments
-
-*DESC
-
-This function applies "fn" to every list of arguments to be found in
-"list". So the first entry of "list" should be a list containing
-the first, second, third, ... argument to "fn", and the same goes
-for the other entries of "list". The function can either be given as
-a string or as a pure function (see Apply for more information on
-pure functions).
-
-*E.G.
-
- In> MapSingle("Sin",{a,b,c});
- Out> {Sin(a),Sin(b),Sin(c)};
- In> Map("+",{{a,b},{c,d}});
- Out> {a+c,b+d};
-
-*SEE MapSingle, MapArgs, Apply
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MapSingle.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MapSingle.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/MapSingle.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/MapSingle.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-%mathpiper,def="MapSingle"
-
-TemplateFunction("MapSingle",{func,list})
-[
- Local(mapsingleresult);
- mapsingleresult:={};
-
- ForEach(mapsingleitem,list)
- [
- DestructiveInsert(mapsingleresult,1,
- Apply(func,{mapsingleitem}));
- ];
- DestructiveReverse(mapsingleresult);
-];
-UnFence("MapSingle",2);
-HoldArg("MapSingle",func);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MapSingle",categories="User Functions;Lists (Operations)"
-*CMD MapSingle --- apply a unary function to all entries in a list
-*STD
-*CALL
- MapSingle(fn, list)
-
-*PARMS
-
-{fn} -- function to apply
-
-{list} -- list of arguments
-
-*DESC
-
-The function "fn" is successively applied to all entries in
-"list", and a list containing the respective results is
-returned. The function can be given either as a string or as a pure
-function (see Apply for more information on pure functions).
-
-The {/@} operator provides a shorthand for
-{MapSingle}.
-
-*E.G.
-
- In> MapSingle("Sin",{a,b,c});
- Out> {Sin(a),Sin(b),Sin(c)};
- In> MapSingle({{x},x^2}, {a,2,c});
- Out> {a^2,4,c^2};
-
-*SEE Map, MapArgs, /@, Apply
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Partition.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Partition.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Partition.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Partition.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="Partition"
-
-/* ���� Partition ���� */
-
-/* Partition( list, n ) partitions 'list' into non-overlapping sublists of length n */
-
-Partition(lst, len):=
- If( Length(lst) < len Or len = 0, {},
- Concat( {Take(lst,len)}, Partition(Drop(lst,len), len) ));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Partition",categories="User Functions;Lists (Operations)"
-*CMD Partition --- partition a list in sublists of equal length
-*STD
-*CALL
- Partition(list, n)
-
-*PARMS
-
-{list} -- list to partition
-
-{n} -- length of partitions
-
-*DESC
-
-This command partitions "list" into non-overlapping sublists of
-length "n" and returns a list of these sublists. The first "n"
-entries in "list" form the first partition, the entries from
-position "n+1" up to "2n" form the second partition, and so on. If
-"n" does not divide the length of "list", the remaining entries
-will be thrown away. If "n" equals zero, an empty list is
-returned.
-
-*E.G.
-
- In> Partition({a,b,c,d,e,f,}, 2);
- Out> {{a,b},{c,d},{e,f}};
- In> Partition(1 .. 11, 3);
- Out> {{1,2,3},{4,5,6},{7,8,9}};
-
-*SEE Take, PermutationsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PopBack.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PopBack.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PopBack.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PopBack.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="PopBack"
-
-Function("PopBack",{stack}) Pop(stack,Length(stack));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PopBack",categories="User Functions;Lists (Operations)"
-*CMD PopBack --- remove an element from the bottom of a stack
-*STD
-*CALL
- PopBack(stack)
-
-*PARMS
-
-{stack} -- a list (which serves as the stack container)
-
-*DESC
-
-This is part of a simple implementation of a stack, internally
-represented as a list. This command removes the element at the bottom
-of the stack and returns this element. Of course, the stack should not
-be empty.
-
-*E.G.
-
- In> stack := {};
- Out> {};
- In> Push(stack, x);
- Out> {x};
- In> Push(stack, x2);
- Out> {x2,x};
- In> Push(stack, x3);
- Out> {x3,x2,x};
- In> PopBack(stack);
- Out> x;
- In> stack;
- Out> {x3,x2};
-
-*SEE Push, Pop, PopFront
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PopFront.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PopFront.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PopFront.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PopFront.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="PopFront"
-
-Function("PopFront",{stack}) Pop(stack,1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PopFront",categories="User Functions;Lists (Operations)"
-*CMD PopFront --- remove an element from the top of a stack
-*STD
-*CALL
- PopFront(stack)
-
-*PARMS
-
-{stack} -- a list (which serves as the stack container)
-
-*DESC
-
-This is part of a simple implementation of a stack, internally
-represented as a list. This command removes the element on the top of
-the stack and returns it. This is the last element that is pushed onto
-the stack.
-
-*E.G.
-
- In> stack := {};
- Out> {};
- In> Push(stack, x);
- Out> {x};
- In> Push(stack, x2);
- Out> {x2,x};
- In> Push(stack, x3);
- Out> {x3,x2,x};
- In> PopFront(stack);
- Out> x3;
- In> stack;
- Out> {x2,x};
-
-*SEE Push, Pop, PopBack
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Pop.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Pop.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Pop.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Pop.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="Pop"
-
-Function("Pop",{stack,index})
-[
- Local(result);
- result:=stack[index];
- DestructiveDelete(stack,index);
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Pop",categories="User Functions;Lists (Operations)"
-*CMD Pop --- remove an element from a stack
-*STD
-*CALL
- Pop(stack, n)
-
-*PARMS
-
-{stack} -- a list (which serves as the stack container)
-
-{n} -- index of the element to remove
-
-*DESC
-
-This is part of a simple implementation of a stack, internally
-represented as a list. This command removes the element with index
-"n" from the stack and returns this element. The top of the stack is
-represented by the index 1. Invalid indices, for example indices
-greater than the number of element on the stack, lead to an error.
-
-*E.G.
-
- In> stack := {};
- Out> {};
- In> Push(stack, x);
- Out> {x};
- In> Push(stack, x2);
- Out> {x2,x};
- In> Push(stack, x3);
- Out> {x3,x2,x};
- In> Pop(stack, 2);
- Out> x2;
- In> stack;
- Out> {x3,x};
-
-*SEE Push, PopFront, PopBack
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PrintList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PrintList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/PrintList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/PrintList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="PrintList"
-
-//////////////////////////////////////////////////
-/// Print a list using a padding string
-//////////////////////////////////////////////////
-
-10 # PrintList(list_IsList) <-- PrintList(list, ", ");
-10 # PrintList({}, padding_IsString) <-- "";
-20 # PrintList(list_IsList, padding_IsString) <-- ToString() [
- Local(i);
- ForEach(i, list) [
- If(Not(Equals(i, First(list))), WriteString(padding));
- If (IsString(i), WriteString(i), If(IsList(i), WriteString("{" : PrintList(i, padding) : "}"), Write(i)));
- ];
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PrintList",categories="User Functions;Lists (Operations)"
-*CMD PrintList --- print list with padding
-*STD
-*CALL
- PrintList(list)
- PrintList(list, padding);
-
-*PARMS
-
-{list} -- a list to be printed
-
-{padding} -- (optional) a string
-
-*DESC
-
-Prints {list} and inserts the {padding} string between each pair of items of the list. Items of the list which are strings are printed without quotes, unlike {Write()}. Items of the list which are themselves lists are printed inside braces {{}}. If padding is not specified, a standard one is used (comma, space).
-
-*E.G.
-
- In> PrintList({a,b,{c, d}}, " .. ")
- Out> " a .. b .. { c .. d}";
-
-*SEE Write, WriteString
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Push.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Push.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Push.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Push.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="Push"
-
-Function("Push",{stack,element})
-[
- DestructiveInsert(stack,1,element);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Push",categories="User Functions;Lists (Operations)"
-*CMD Push --- add an element on top of a stack
-*STD
-*CALL
- Push(stack, expr)
-
-*PARMS
-
-{stack} -- a list (which serves as the stack container)
-
-{expr} -- expression to push on "stack"
-
-*DESC
-
-This is part of a simple implementation of a stack, internally
-represented as a list. This command pushes the expression "expr" on
-top of the stack, and returns the stack afterwards.
-
-*E.G.
-
- In> stack := {};
- Out> {};
- In> Push(stack, x);
- Out> {x};
- In> Push(stack, x2);
- Out> {x2,x};
- In> PopFront(stack);
- Out> x2;
-
-*SEE Pop, PopFront, PopBack
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/RemoveDuplicates.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/RemoveDuplicates.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/RemoveDuplicates.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/RemoveDuplicates.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="RemoveDuplicates"
-
-Function("RemoveDuplicates",{list})
-[
- Local(result);
- Set(result,{});
- ForEach(item,list)
- If(Not(Contains(result,item)),DestructiveAppend(result,item));
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="RemoveDuplicates",categories="User Functions;Lists (Operations)"
-*CMD RemoveDuplicates --- remove any duplicates from a list
-*STD
-*CALL
- RemoveDuplicates(list)
-
-*PARMS
-
-{list} -- list to act on
-
-*DESC
-
-This command removes all duplicate elements from a given list and returns the resulting list.
-To be
-precise, the second occurrence of any entry is deleted, as are the
-third, the fourth, etc.
-
-*E.G.
-
- In> RemoveDuplicates({1,2,3,2,1});
- Out> {1,2,3};
- In> RemoveDuplicates({a,1,b,1,c,1});
- Out> {a,1,b,c};
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Remove.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Remove.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Remove.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Remove.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="Remove"
-
-Remove(list, expression) :=
-[
- Local(result);
- Set(result,{});
- ForEach(item,list)
- If(item != expression, DestructiveAppend(result,item));
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Remove"
-*CMD Remove --- remove all occurrences of an expression from a list
-*STD
-*CALL
- Remove(list, expr)
-
-*PARMS
-
-{list} -- list to act on
-
-{expr} -- expression to look for in "list"
-
-*DESC
-
-This command removes all elements that match a given expression from a given list and returns the resulting list.
-
-*E.G.
-
- In> Remove({a,b,a,b,c,a,c},a)
- Result> {b,b,c,c}
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Reverse.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Reverse.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Reverse.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Reverse.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="Reverse"
-
-// Non-destructive Reverse operation
-Reverse(list):=DestructiveReverse(FlatCopy(list));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Reverse",categories="User Functions;Lists (Operations)"
-*CMD Reverse --- return the reversed list (without touching the original)
-*STD
-*CALL
- Reverse(list)
-
-*PARMS
-
-{list} -- list to reverse
-
-*DESC
-
-This function returns a list reversed, without changing the
-original list. It is similar to {DestructiveReverse}, but safer
-and slower.
-
-
-*E.G.
-
- In> lst:={a,b,c,13,19}
- Out> {a,b,c,13,19};
- In> revlst:=Reverse(lst)
- Out> {19,13,c,b,a};
- In> lst
- Out> {a,b,c,13,19};
-
-*SEE FlatCopy, DestructiveReverse
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/scopestack/scopestack.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/scopestack/scopestack.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/scopestack/scopestack.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/scopestack/scopestack.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,78 +0,0 @@
-%mathpiper,def="NewStack;PushStackFrame;PopStackFrame;StackDepth;AddToStack;IsOnStack;FindOnStack"
-
-/* def file list
-NewStack
-PushStackFrame
-PopStackFrame
-StackDepth
-AddToStack
-IsOnStack
-FindOnStack
-
-*/
-
-
-/*
- Stack simulator. Api:
-
- NewStack() - creates a stack simulation
- PushStackFrame(stack,unfenced) - push frame on stack, (un)fenced
- PushStackFrame(stack,fenced)
- PopStackFrame(stack) - pop stack frame
- StackDepth(_stack) - return stack depth
- AddToStack(stack,element) - add element to top stack frame
-
- IsOnStack(stack,element) - returns True if element is accessible
- on current stack, False otherwise
- FindOnStack(stack,element) - return assoc list for element.
- Check first with IsOnStack that it is available!
-
-*/
-
-NewStack() := {{},{}};
-
-10 # PushStackFrame(_stack,unfenced)
- <--
- [
- DestructiveInsert(stack[1],1,{});
- DestructiveInsert(stack[2],1,True);
- ];
-10 # PushStackFrame(_stack,fenced)
- <--
- [
- DestructiveInsert(stack[1],1,{});
- DestructiveInsert(stack[2],1,False);
- ];
-PopStackFrame(stack):=
-[
- DestructiveDelete(stack[1],1);
- DestructiveDelete(stack[2],1);
-];
-StackDepth(_stack) <-- Length(stack[1]);
-
-AddToStack(stack,element) :=
-[
- DestructiveInsert(stack[1][1],1,{element,{}});
-];
-
-DropOneFrame(_stack) <-- {Rest(stack[1]),Rest(stack[2])};
-
-10 # IsOnStack({{},{}},_element) <-- False;
-11 # IsOnStack(_stack,_element)_(stack[1][1][element] != Empty) <-- True;
-20 # IsOnStack(_stack,_element)_(StackDepth(stack)>0 And stack[2][1] = True)
- <-- IsOnStack(DropOneFrame(stack),element);
-30 # IsOnStack(_stack,_element) <--
-[
-//Echo("stack depth = ",StackDepth(stack));
-//Echo(stack[2][1]);
-False;
-];
-10 # FindOnStack(_stack,_element)_(stack[1][1][element] != Empty)
- <-- stack[1][1][element];
-20 # FindOnStack(_stack,_element)_(StackDepth(stack)>0 And stack[2][1] = True)
- <-- FindOnStack(DropOneFrame(stack),element);
-30 # FindOnStack(_stack,_element) <-- Check(False,"Illegal stack access! Use IsOnStack.");
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/SmallSort.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/SmallSort.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/SmallSort.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/SmallSort.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-%mathpiper,def="SmallSort"
-
-/// fast in-place sorting of a list (or array!)
-/// SmallSort sorts up to 3 elements, HeapSort sorts 4 and more elements
-SmallSort(_list, _first, _last, _compare) _ (last=first) <-- list;
-SmallSort(_list, _first, _last, _compare) _ (last=first+1) <--
-[
- Local(temp);
- temp := list[first];
- If(
- Apply(compare,{temp,list[last]}),
- list,
- [
- list[first] := list[last];
- list[last] := temp;
- ] //Swap(list, first, last)
- );
- list;
-];
-SmallSort(_list, _first, _last, _compare) _ (last=first+2) <--
-[
- Local(temp);
- temp := list[first];
- If(
- Apply(compare,{list[first+1],temp}),
- [
- list[first] := list[first+1];
- list[first+1] := temp;
- ] //Swap(list, first, first+1) // x>y, z
- );
- // xx 1, 2, 3
- list[last] := list[first+1];
- list[first+1] := list[first];
- list[first] := temp;
- ]
- );
- list;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Swap.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Swap.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Swap.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Swap.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="Swap"
-
-Function("Swap",{list,index1,index2})
-[
- Local(item1,item2);
- item1:=list[index1];
- item2:=list[index2];
- list[index1] := item2;
- list[index2] := item1;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Swap",categories="User Functions;Lists (Operations)"
-*CMD Swap --- swap two elements in a list
-*STD
-*CALL
- Swap(list, i1, i2)
-
-*PARMS
-
-{list} -- the list in which a pair of entries should be swapped
-
-{i1, i2} -- indices of the entries in "list" to swap
-
-*DESC
-
-This command swaps the pair of entries with entries "i1" and "i2"
-in "list". So the element at index "i1" ends up at index "i2"
-and the entry at "i2" is put at index "i1". Both indices should be
-valid to address elements in the list. Then the updated list is
-returned.
-
-{Swap()} works also on generic arrays.
-
-*E.G.
-
- In> lst := {a,b,c,d,e,f};
- Out> {a,b,c,d,e,f};
- In> Swap(lst, 2, 4);
- Out> {a,d,c,b,e,f};
-
-*SEE Replace, DestructiveReplace, Array'Create
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Table.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Table.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Table.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Table.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-%mathpiper,def="Table"
-
-/* Juan: TemplateFunction (as defined in the file "deffunc")
- * also makes the arguments to the function local symbols.
- * Use HoldArgNr to specify the index of a variable to hold
- * (since they are defined as local symbols).
- */
-
-LocalSymbols(result,nr,ii)
-TemplateFunction("Table",{body,var,count'from,count'to,step})
- [
- MacroLocal(var);
- result:={};
- nr := (count'to - count'from) / step;
- ii := 0;
- While( ii <= nr )
- [
- MacroSet( var, count'from + ii * step );
- DestructiveInsert( result,1,Eval(body) );
- Set(ii,AddN(ii,1));
- ];
- DestructiveReverse(result);
- ];
-HoldArgNr("Table",5,1); /* body */
-HoldArgNr("Table",5,2); /* var */
-UnFence("Table",5);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Table",categories="User Functions;Lists (Operations)"
-*CMD Table --- evaluate while some variable ranges over interval
-*STD
-*CALL
- Table(body, var, from, to, step)
-
-*PARMS
-
-{body} -- expression to evaluate multiple times
-
-{var} -- variable to use as loop variable
-
-{from} -- initial value for "var"
-
-{to} -- final value for "var"
-
-{step} -- step size with which "var" is incremented
-
-*DESC
-
-This command generates a list of values from "body", by assigning
-variable "var" values from "from" up to "to", incrementing
-"step" each time. So, the variable "var" first gets the value
-"from", and the expression "body" is evaluated. Then the value
-"from"+"step" is assigned to "var" and the expression "body"
-is again evaluated. This continues, incrementing "var" with "step"
-on every iteration, until "var" exceeds "to". At that moment, all
-the results are assembled in a list and this list is returned.
-
-*E.G.
-
- In> Table(i!, i, 1, 9, 1);
- Out> {1,2,6,24,120,720,5040,40320,362880};
- In> Table(i, i, 3, 16, 4);
- Out> {3,7,11,15};
- In> Table(i^2, i, 10, 1, -1);
- Out> {100,81,64,49,36,25,16,9,4,1};
-
-*SEE For, MapSingle, .., TableForm
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Take.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Take.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Take.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Take.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-%mathpiper,def="Take"
-
-/* ���� Take ���� */
-
-/* Needs to check the parameters */
-
-/*
- * Take( list, n ) gives the first n elements of 'list'
- * Take( list, -n ) gives the last n elements of 'list'
- * Take( list, {m,n} ) elements m through n of 'list'
- */
-
-RuleBase("Take", {lst, range});
-
-Rule("Take", 2, 1, IsList(range))
- Take( Drop(lst, range[1] -1), range[2] - range[1] + 1);
-
-Rule("Take", 2, 2, range >= 0)
- If( Length(lst)=0 Or range=0, {},
- Concat({First(lst)}, Take(Rest(lst), range-1)));
-
-Rule("Take", 2, 2, range < 0)
- Drop( lst, Length(lst) + range );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Take",categories="User Functions;Lists (Operations)"
-*CMD Take --- take a sublist from a list (dropping the rest)
-*STD
-*CALL
- Take(list, n)
- Take(list, -n)
- Take(list, {m,n})
-
-*PARMS
-
-{list} -- list to act on
-
-{n}, {m} -- positive integers describing the entries to take
-
-*DESC
-
-This command takes a sublist of "list", drops the rest, and returns
-the selected sublist. The first calling sequence selects the first
-"n" entries in "list". The second form takes the last "n"
-entries. The last invocation selects the sublist beginning with entry
-number "m" and ending with the "n"-th entry.
-
-*E.G.
-
- In> lst := {a,b,c,d,e,f,g};
- Out> {a,b,c,d,e,f,g};
- In> Take(lst, 2);
- Out> {a,b};
- In> Take(lst, -3);
- Out> {e,f,g};
- In> Take(lst, {2,4});
- Out> {b,c,d};
-
-*SEE Drop, Select, Remove
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Union.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Union.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/Union.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/Union.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-%mathpiper,def="Union"
-
-Function("Union",{list1,list2})
-[
- RemoveDuplicates(Concat(list1,list2));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Union",categories="User Functions;Lists (Operations)"
-*CMD Union --- return the union of two lists
-*STD
-*CALL
- Union(l1, l2)
-
-*PARMS
-
-{l1}, {l2} -- two lists
-
-*DESC
-
-The union of the lists "l1" and "l2" is determined and
-returned. The union contains all elements that occur in one or both of
-the lists. In the resulting list, any element will occur only once.
-
-*E.G.
-
- In> Union({a,b,c}, {b,c,d});
- Out> {a,b,c,d};
- In> Union({a,e,i,o,u}, {f,o,u,r,t,e,e,n});
- Out> {a,e,i,o,u,f,r,t,n};
- In> Union({1,2,2,3,3,3}, {2,2,3,3,4,4});
- Out> {1,2,3,4};
-
-*SEE Intersection, Difference
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListAll.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListAll.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListAll.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListAll.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,28 +0,0 @@
-%mathpiper,def="VarListAll"
-
-/*
- * RuleBase for VarListAll: recursively traverse an expression looking
- * up all variables the expression depends on.
- */
-/* Accept any variable. */
-
-VarListAll(_expr) <-- VarListAll(expr,"IsVariable");
-
-10 # VarListAll(_expr,_filter)_(Apply(filter,{expr}) = True) <--
- {expr};
-
-/* Otherwise check all leafs of a function. */
-20 # VarListAll(expr_IsFunction,_filter) <--
-[
- Local(item,result, flatlist);
- Set(flatlist,Rest(Listify(expr)));
- Set(result,{});
- ForEach(item,flatlist)
- Set(result,Concat(result,VarListAll(item,filter)));
- result;
-];
-
-/* Else it doesn't depend on any variable. */
-30 # VarListAll(_expr,_filter) <-- {};
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListArith.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListArith.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListArith.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListArith.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,57 +0,0 @@
-%mathpiper,def="VarListArith"
-
-/// VarListArith --- obtain arithmetic variables
-// currently the VarList(x,y) semantic is convoluted so let's introduce a new name; but in principle this needs to be cleaned up
-VarListArith(expr) := VarListSome(expr, {Atom("+"), Atom("-"), *, /});
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="VarListArith",categories="User Functions;Lists (Operations)"
-*CMD VarList --- list of variables appearing in an expression
-*CMD VarListArith --- list of variables appearing in an expression
-*CMD VarListSome --- list of variables appearing in an expression
-*STD
-*CALL
- VarList(expr)
- VarListArith(expr)
- VarListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- a list of function atoms
-
-*DESC
-
-The command {VarList(expr)} returns a list of all variables that appear in the
-expression {expr}. The expression is traversed recursively.
-
-The command {VarListSome} looks only at arguments of functions in the {list}. All other functions are considered "opaque" (as if they do not contain any variables) and their arguments are not checked.
-For example, {VarListSome(a + Sin(b-c))} will return {{a, b, c}}, but {VarListSome(a*Sin(b-c), {*})} will not look at arguments of {Sin()} and will return {{a,Sin(b-c)}}. Here {Sin(b-c)} is considered a "variable" because the function {Sin} does not belong to {list}.
-
-
-The command {VarListArith} returns a list of all variables that appear
-arithmetically in the expression {expr}. This is implemented through
-{VarListSome} by restricting to the arithmetic functions {+}, {-}, {*}, {/}.
-Arguments of other functions are not checked.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> VarList(Sin(x))
- Out> {x};
- In> VarList(x+a*y)
- Out> {x,a,y};
- In> VarListSome(x+a*y, {Atom("+")})
- Out> {x,a*y};
- In> VarListArith(x+y*Cos(Ln(x)/x))
- Out> {x,y,Cos(Ln(x)/x)}
- In> VarListArith(x+a*y^2-1)
- Out> {x,a,y^2};
-
-*SEE IsFreeOf, IsVariable, FuncList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,61 +0,0 @@
-%mathpiper,def="VarList"
-
-/* VarList: return the variables this expression depends on. */
-VarList(_expr) <-- VarList(expr,"IsVariable");
-
-Function("VarList",{expr,filter})
-[
- RemoveDuplicates(VarListAll(expr,filter));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="VarList",categories="User Functions;Lists (Operations)"
-*CMD VarList --- list of variables appearing in an expression
-*CMD VarListArith --- list of variables appearing in an expression
-*CMD VarListSome --- list of variables appearing in an expression
-*STD
-*CALL
- VarList(expr)
- VarListArith(expr)
- VarListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- a list of function atoms
-
-*DESC
-
-The command {VarList(expr)} returns a list of all variables that appear in the
-expression {expr}. The expression is traversed recursively.
-
-The command {VarListSome} looks only at arguments of functions in the {list}. All other functions are considered "opaque" (as if they do not contain any variables) and their arguments are not checked.
-For example, {VarListSome(a + Sin(b-c))} will return {{a, b, c}}, but {VarListSome(a*Sin(b-c), {*})} will not look at arguments of {Sin()} and will return {{a,Sin(b-c)}}. Here {Sin(b-c)} is considered a "variable" because the function {Sin} does not belong to {list}.
-
-
-The command {VarListArith} returns a list of all variables that appear
-arithmetically in the expression {expr}. This is implemented through
-{VarListSome} by restricting to the arithmetic functions {+}, {-}, {*}, {/}.
-Arguments of other functions are not checked.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> VarList(Sin(x))
- Out> {x};
- In> VarList(x+a*y)
- Out> {x,a,y};
- In> VarListSome(x+a*y, {Atom("+")})
- Out> {x,a*y};
- In> VarListArith(x+y*Cos(Ln(x)/x))
- Out> {x,y,Cos(Ln(x)/x)}
- In> VarListArith(x+a*y^2-1)
- Out> {x,a,y^2};
-
-*SEE IsFreeOf, IsVariable, FuncList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListSome.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListSome.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/lists/VarListSome.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/lists/VarListSome.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-%mathpiper,def="VarListSome"
-
-/// VarListSome is just like FuncList(x,y)
-
-10 # VarListSome({}, _look'list) <-- {};
-// an atom should be a variable to qualify
-10 # VarListSome(expr_IsVariable, _look'list) <-- {expr};
-15 # VarListSome(expr_IsAtom, _look'list) <-- {};
-// a function not in the looking list - return it whole
-20 # VarListSome(expr_IsFunction, look'list_IsList)_(Not Contains(look'list, Atom(Type(expr)))) <-- {expr};
-// a function in the looking list - traverse its arguments
-30 # VarListSome(expr_IsFunction, look'list_IsList) <--
-RemoveDuplicates(
- [ // obtain a list of functions, considering only functions in look'list
- Local(item, result);
- result := {};
- ForEach(item, expr) result := Concat(result, VarListSome(item, look'list));
- result;
- ]
-);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="VarListSome",categories="User Functions;Lists (Operations)"
-*CMD VarList --- list of variables appearing in an expression
-*CMD VarListArith --- list of variables appearing in an expression
-*CMD VarListSome --- list of variables appearing in an expression
-*STD
-*CALL
- VarList(expr)
- VarListArith(expr)
- VarListSome(expr, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{list} -- a list of function atoms
-
-*DESC
-
-The command {VarList(expr)} returns a list of all variables that appear in the
-expression {expr}. The expression is traversed recursively.
-
-The command {VarListSome} looks only at arguments of functions in the {list}. All other functions are considered "opaque" (as if they do not contain any variables) and their arguments are not checked.
-For example, {VarListSome(a + Sin(b-c))} will return {{a, b, c}}, but {VarListSome(a*Sin(b-c), {*})} will not look at arguments of {Sin()} and will return {{a,Sin(b-c)}}. Here {Sin(b-c)} is considered a "variable" because the function {Sin} does not belong to {list}.
-
-
-The command {VarListArith} returns a list of all variables that appear
-arithmetically in the expression {expr}. This is implemented through
-{VarListSome} by restricting to the arithmetic functions {+}, {-}, {*}, {/}.
-Arguments of other functions are not checked.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> VarList(Sin(x))
- Out> {x};
- In> VarList(x+a*y)
- Out> {x,a,y};
- In> VarListSome(x+a*y, {Atom("+")})
- Out> {x,a*y};
- In> VarListArith(x+y*Cos(Ln(x)/x))
- Out> {x,y,Cos(Ln(x)/x)}
- In> VarListArith(x+a*y^2-1)
- Out> {x,a,y^2};
-
-*SEE IsFreeOf, IsVariable, FuncList, HasExpr, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/AddTo.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/AddTo.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/AddTo.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/AddTo.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,72 +0,0 @@
-%mathpiper,def="AddTo"
-
-// (a or b) and (c or d) -> (a and c) or (a and d) or (b and c) or (b and d)
-20 # (list_IsList AddTo _rest) <--
-[
- Local(res);
- res:={};
- ForEach(item,list)
- [
- res := Concat(res,item AddTo rest);
- ];
- res;
-];
-30 # (_a'item AddTo list_IsList) <--
-[
- MapSingle({{orig},a'item And orig},list);
-];
-40 # (_a'item AddTo _b) <-- a'item And b;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="AddTo",categories="User Functions;Functional Operators"
-*CMD AddTo --- add an equation to a set of equations or set of set of equations
-*STD
-*CALL
- eq1 AddTo eq2
-
-*PARMS
-
-{eq} - (set of) set of equations
-
-*DESC
-
-Given two (sets of) sets of equations, the command AddTo combines
-multiple sets of equations into one.
-
-A list {a,b} means that a is a solution, OR b is a solution.
-AddTo then acts as a AND operation:
-
- (a or b) and (c or d) =>
- (a or b) Addto (c or d) =>
- (a and c) or (a and d) or (b and c)
- or (b and d)
-
-This function is useful for adding an identity to an already
-existing set of equations. Suppose a solve command returned
-{a>=0 And x==a,a<0 And x== -a} from an expression x==Abs(a),
-then a new identity a==2 could be added as follows:
-
- In> a==2 AddTo {a>=0 And x==a,a<0 And x== -a}
- Out> {a==2 And a>=0 And x==a,a==2 And a<0
- And x== -a};
-
-Passing this set of set of identities back to solve, solve
-should recognize that the second one is not a possibility
-any more, since a==2 And a<0 can never be true at the same time.
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> {A==2,c==d} AddTo {b==3 And d==2}
- Out> {A==2 And b==3 And d==2,c==d
- And b==3 And d==2};
- In> {A==2,c==d} AddTo {b==3, d==2}
- Out> {A==2 And b==3,A==2 And d==2,c==d
- And b==3,c==d And d==2};
-
-*SEE Where, Solve
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/CompilePatterns.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/CompilePatterns.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/CompilePatterns.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/CompilePatterns.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,94 +0,0 @@
-%mathpiper,def="CompilePatterns"
-
-LocalSymbols(LocResult) [
-
- Set(LocResult,True);
- 10 # LocPredicate(exp_IsAtom) <--
- [
- Local(tr,result);
- tr:=patterns;
- result:=False;
- While (tr != {})
- [
- If (First(First(tr)) = exp,
- [
- Set(LocResult,Eval(First(Rest(First(tr)))));
- result := True;
- tr:={};
- ],
- [
- tr := Rest(tr);
- ]);
- ];
- result;
- ];
-
- 10 # LocPredicate(exp_IsFunction) <--
- [
- Local(tr,result,head);
- tr:=patterns;
- result:=False;
- While (tr != {})
- [
- Set(head, First(First(tr)));
- If (Not(IsAtom(head)) And exp[0]=head[1] And Pattern'Matches(head[2], exp),
- [
- Set(LocResult,Eval(First(Rest(First(tr)))));
- Set(result, True);
- Set(tr,{});
- ],
- [
- Set(tr, Rest(tr));
- ]);
- ];
- result;
- ];
- 20 # LocPredicate(_exp) <-- False;
-
- LocChange(_exp) <-- LocResult;
-]; // LocalSymbols(LocResult)
-
-UnFence("LocPredicate",1);
-UnFence("LocChange",1);
-
-10 # LocProcessSingle({_pat,_post,_exp}) <-- { {pat[0],Pattern'Create(pat,post)},exp };
-
-20 # LocProcessSingle({pat_IsFunction,_exp}) <-- { {pat[0],Pattern'Create(pat,True)},exp };
-
-30 # LocProcessSingle({pat_IsAtom,_exp}) <-- { pat,exp };
-
-/*
- 40 # LocProcessSingle(pat_IsFunction <- _exp) <-- { {pat[0],Pattern'Create(pat,True)},exp };
- todo:tk:this rule was not handling post predicates so I replaced it with a new version that does.
- I suspect that the other rules for this Rulebase have problems too.
-*/
-40 # LocProcessSingle(pat_IsFunction <- _exp) <--
-[
- Local(justPattern, postPredicate);
-
- If(Type(pat) = "_",
- [
- //A post predicate was submitted.
- justPattern := pat[1];
- postPredicate := pat[2];
- ],
- [
- //No post predicate was submitted.
- justPattern := pat;
- postPredicate := True;
- ]
- );
-
- { {justPattern[0],Pattern'Create(justPattern,postPredicate)},exp };
-];
-
-50 # LocProcessSingle(pat_IsAtom <- _exp) <-- { pat,exp };
-
-LocProcess(patterns) :=
-[
- MapSingle("LocProcessSingle",patterns);
-];
-
-CompilePatterns(patterns) := LocPatterns(LocProcess(patterns));
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/lessthan_minus_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/lessthan_minus_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/lessthan_minus_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/lessthan_minus_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-%mathpiper,def="<-"
-
-RuleBase("<-",{left,right});
-HoldArg("<-",left);
-HoldArg("<-",right);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/slash_colon_colon_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/slash_colon_colon_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/slash_colon_colon_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/slash_colon_colon_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,91 +0,0 @@
-%mathpiper,def="/::"
-
-5 # (_expression /:: LocPatterns(_patterns)) <--
-[
- MacroSubstitute(expression,"LocPredicate","LocChange");
-];
-10 # (_expression /:: _patterns) <--
-[
- Local(old);
- Set(patterns, LocProcess(patterns));
- Set(old, expression);
- Set(expression, MacroSubstitute(expression,"LocPredicate","LocChange"));
- While (expression != old)
- [
- Set(old, expression);
- Set(expression, MacroSubstitute(expression,"LocPredicate","LocChange"));
- ];
- expression;
-];
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="/::",categories="Operators"
-*CMD /: --- local simplification rules
-*CMD /:: --- local simplification rules
-*STD
-*CALL
- expression /: patterns
- expressions /:: patterns
-Precedence:
-*EVAL OpPrecedence("/:")
-
-
-*PARMS
-
-{expression} -- an expression
-
-{patterns} -- a list of patterns
-
-*DESC
-
-Sometimes you have an expression, and you want to use specific
-simplification rules on it that are not done by default. This
-can be done with the {/:} and the {/::} operators. Suppose we have the
-expression containing things such as {Ln(a*b)}, and we want
-to change these into {Ln(a)+Ln(b)}, the easiest way
-to do this is using the {/:} operator, as follows:
-
- In> Sin(x)*Ln(a*b)
- Out> Sin(x)*Ln(a*b);
- In> % /: { Ln(_x*_y) <- Ln(x)+Ln(y) }
- Out> Sin(x)*(Ln(a)+Ln(b));
-
-A whole list of simplification rules can be built up in the list,
-and they will be applied to the expression on the left hand side
-of {/:} .
-
-The forms the patterns can have are one of:
-
- pattern <- replacement
- {pattern,replacement}
- {pattern,postpredicate,replacement}
-
-Note that for these local rules, {<-} should be used instead of
-{<--} which would be used in a global rule.
-
-The {/:} operator traverses an expression much as {Subst} does, that is, top
-down, trying to apply the rules from the beginning of the list of
-rules to the end of the list of rules. If the rules cannot be applied
-to an expression, it will try subexpressions of that
-expression and so on.
-
-It might be necessary sometimes to use the {/::} operator, which
-repeatedly applies the {/:} operator until the result doesn't change
-any more. Caution is required, since rules can contradict each other,
-which could result in an infinite loop. To detect this situation,
-just use /: repeatedly on the expression. The repetitive nature
-should become apparent.
-
-*E.G.
-
- In> Sin(u)*Ln(a*b) /: {Ln(_x*_y) <- Ln(x)+Ln(y)}
- Out> Sin(u)*(Ln(a)+Ln(b));
- In> Sin(u)*Ln(a*b) /:: { a <- 2, b <- 3 }
- Out> Sin(u)*Ln(6);
-
-*SEE Subst
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/slash_colon_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/slash_colon_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/slash_colon_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/slash_colon_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,101 +0,0 @@
-%mathpiper,def="/:"
-
-5 # (_expression /: LocPatterns(_patterns)) <--
-[
- MacroSubstitute(expression,"LocPredicate","LocChange");
-];
-
-
-10 # (_expression /: _patterns) <--
-[
- Set(patterns, LocProcess(patterns));
- MacroSubstitute(expression,"LocPredicate","LocChange");
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="/:",categories="Operators"
-*CMD /: --- local simplification rules
-*CMD /:: --- local simplification rules
-*STD
-*CALL
- expression /: patterns
- expressions /:: patterns
-Precedence:
-*EVAL OpPrecedence("/:")
-
-
-*PARMS
-
-{expression} -- an expression
-
-{patterns} -- a list of patterns
-
-*DESC
-
-Sometimes you have an expression, and you want to use specific
-simplification rules on it that are not done by default. This
-can be done with the {/:} and the {/::} operators. Suppose we have the
-expression containing things such as {Ln(a*b)}, and we want
-to change these into {Ln(a)+Ln(b)}, the easiest way
-to do this is using the {/:} operator, as follows:
-
- In> Sin(x)*Ln(a*b)
- Out> Sin(x)*Ln(a*b);
- In> % /: { Ln(_x*_y) <- Ln(x)+Ln(y) }
- Out> Sin(x)*(Ln(a)+Ln(b));
-
-A whole list of simplification rules can be built up in the list,
-and they will be applied to the expression on the left hand side
-of {/:} .
-
-The forms the patterns can have are one of:
-
- pattern <- replacement
- {pattern,replacement}
- {pattern,postpredicate,replacement}
-
-Note that for these local rules, {<-} should be used instead of
-{<--} which would be used in a global rule.
-
-The {/:} operator traverses an expression much as {Subst} does, that is, top
-down, trying to apply the rules from the beginning of the list of
-rules to the end of the list of rules. If the rules cannot be applied
-to an expression, it will try subexpressions of that
-expression and so on.
-
-It might be necessary sometimes to use the {/::} operator, which
-repeatedly applies the {/:} operator until the result doesn't change
-any more. Caution is required, since rules can contradict each other,
-which could result in an infinite loop. To detect this situation,
-just use /: repeatedly on the expression. The repetitive nature
-should become apparent.
-
-*E.G.
-
- In> Sin(u)*Ln(a*b) /: {Ln(_x*_y) <- Ln(x)+Ln(y)}
- Out> Sin(u)*(Ln(a)+Ln(b));
- In> Sin(u)*Ln(a*b) /:: { a <- 2, b <- 3 }
- Out> Sin(u)*Ln(6);
-
-*SEE Subst
-%/mathpiper_docs
-
-
-/*
-Examples to add to docs in the future.
-
-Hold((a + b) * (1 + 2) * (2 + 1) * (1/2 + c) * (3/4 + d) ) /:
- {
- (x_IsOdd + y_IsEven) <- m1,
- (x_IsEven + y_IsOdd) <- m2,
- (x_IsRational + y_IsAtom)_(Denominator(x) = 2) <- m3,
- };
-
- %output,preserve="false"
- Result: (a+b)*m1*m2*m3*(3/4+d)
-. %/output
-
-*/
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/Where.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/Where.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/localrules/Where.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/localrules/Where.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,93 +0,0 @@
-%mathpiper,def="Where"
-
-RuleBase("Where",{left,right});
-//HoldArg("Where",left);
-//HoldArg("Where",right);
-UnFence("Where",2);
-10 # (_body Where var_IsAtom == _value)
- <-- `[Local(@var);@var := @value;@body;];
-20 # (_body Where (_a And _b))
- <--
-[
- Set(body,`(@body Where @a));
- `(@body Where @b);
-];
-
-30 # (_body Where {}) <-- {};
-40 # (_body Where list_IsList)_IsList(list[1])
- <--
- [
- Local(head,rest);
- head:=First(list);
- rest:=Rest(list);
- rest:= `(@body Where @rest);
- `(@body Where @head) : rest;
- ];
-
-50 # (_body Where list_IsList)
- <--
- [
- Local(head,rest);
- While (list != {})
- [
- head:=First(list);
- body := `(@body Where @head);
- list:=Rest(list);
- ];
- body;
- ];
-
-
-60 # (_body Where _var == _value) <-- Subst(var,value)body;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Where",categories="User Functions;Functional Operators"
-*CMD Where --- substitute result into expression
-*STD
-*CALL
- expr Where x==v
- expr Where x1==v1 And x2==v2 And ...
- expr Where {x1==v1 And x2==v2,x1==v3
- And x2==v4,...}
-
-*PARMS
-
-{expr} - expression to evaluate
-
-{x} - variable to set
-
-{v} - value to substitute for variable
-
-*DESC
-
-The operator {Where} fills in values for variables, in its simplest form.
-It accepts sets of variable/value pairs defined as
-
- var1==val1 And var2==val2 And ...
-
-and fills in the corresponding values. Lists of value pairs are
-also possible, as:
-
- {var1==val1 And var2==val2, var1==val3
- And var2==val4}
-
-These values might be obtained through {Solve}.
-
-This operator can help the user to program in the style of functional programming languages such as Miranda or Haskell.
-
-*E.G.
-
- In> x^2+y^2 Where x==2
- Out> y^2+4;
- In> x^2+y^2 Where x==2 And y==3
- Out> 13;
- In> x^2+y^2 Where {x==2 And y==3}
- Out> {13};
- In> x^2+y^2 Where {x==2 And y==3,x==4 And y==5}
- Out> {13,41};
-
-*SEE Solve, AddTo
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/CanProve.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/CanProve.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/CanProve.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/CanProve.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,118 +0,0 @@
-%mathpiper,def="CanProve"
-
-/* Small theorem prover for propositional logic, based on the
- * resolution principle.
- * Written by Ayal Pinkus, based on the simple theorem prover from "Prolog, Ivan Bratko, chapter 20"
- * Version 0.1 initial implementation.
- *
- *
- * Examples:
-CanProve(( (a=>b) And (b=>c)=>(a=>c) )) <-- True
-CanProve(a Or Not a) <-- True
-CanProve(True Or a) <-- True
-CanProve(False Or a) <-- a
-CanProve(a And Not a) <-- False
-CanProve(a Or b Or (a And b)) <-- a Or b
- */
-
- // <==> LogicSimplify(expr, 3)
-
-/* CanProve tries to prove that the negation of the negation of
- the proposition is true. Negating twice is just a trick to
- allow all the simplification rules a la De Morgan to operate
- */
-/*CanProve(_proposition) <-- CanProveAux( Not CanProveAux( Not proposition));*/
-
-CanProveAux(_proposition) <-- LogicSimplify(proposition, 3);
-
-CanProve(_proposition) <-- CanProveAux( proposition );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="CanProve",categories="User Functions;Propositional Logic"
-*CMD CanProve --- try to prove statement
-*STD
-*CALL
- CanProve(proposition)
-
-*PARMS
-
-{proposition} -- an expression with logical operations
-
-*DESC
-
-MathPiper has a small built-in propositional logic theorem prover.
-It can be invoked with a call to {CanProve}.
-
-An example of a proposition is: "if a implies b and b implies c then
-a implies c". MathPiper supports the following logical operations:
-
-{Not} : negation, read as "not"
-
-{And} : conjunction, read as "and"
-
-{Or} : disjunction, read as "or"
-
-{=>} : implication, read as "implies"
-
-The abovementioned proposition would be represented by the following expression,
-
- ( (a=>b) And (b=>c) ) => (a=>c)
-
-MathPiper can prove that is correct by applying {CanProve}
-to it:
-
- In> CanProve(( (a=>b) And (b=>c) ) => (a=>c))
- Out> True;
-
-It does this in the following way: in order to prove a proposition $p$, it
-suffices to prove that $Not p$ is false. It continues to simplify $Not p$
-using the rules:
-
- Not ( Not x) --> x
-(eliminate double negation),
- x=>y --> Not x Or y
-(eliminate implication),
- Not (x And y) --> Not x Or Not y
-(De Morgan's law),
- Not (x Or y) --> Not x And Not y
-(De Morgan's law),
- (x And y) Or z --> (x Or z) And (y Or z)
-(distribution),
- x Or (y And z) --> (x Or y) And (x Or z)
-(distribution),
-and the obvious other rules, such as,
- True Or x --> True
-etc.
-The above rules will translate a proposition into a form
-
- (p1 Or p2 Or ...) And (q1 Or q2
- Or ...) And ...
-If any of the clauses is false, the entire expression will be false.
-In the next step, clauses are scanned for situations of the form:
-
- (p Or Y) And ( Not p Or Z) --> (Y Or Z)
-If this combination {(Y Or Z)} is empty, it is false, and
-thus the entire proposition is false.
-
-As a last step, the algorithm negates the result again. This has the
-added advantage of simplifying the expression further.
-
-*E.G.
-
- In> CanProve(a Or Not a)
- Out> True;
- In> CanProve(True Or a)
- Out> True;
- In> CanProve(False Or a)
- Out> a;
- In> CanProve(a And Not a)
- Out> False;
- In> CanProve(a Or b Or (a And b))
- Out> a Or b;
-
-
-*SEE True, False, And, Or, Not
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/CNF.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/CNF.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/CNF.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/CNF.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,99 +0,0 @@
-%mathpiper,def="CNF"
-
-
- // former LogicSimplify
-
-/*
- Simplify a boolean expression. CNF is responsible
- for converting an expression to the following form:
- (p1 Or p2 Or ...) And (q1 Or q2 Or ...) And ...
- That is, a conjunction of disjunctions.
-*/
-
-
-// Trivial simplifications
-10 # CNF( Not True) <-- False;
-11 # CNF( Not False) <-- True;
-12 # CNF(True And (_x)) <-- CNF(x);
-13 # CNF(False And (_x)) <-- False;
-14 # CNF(_x And True) <-- CNF(x);
-15 # CNF(_x And False) <-- False;
-16 # CNF(True Or (_x)) <-- True;
-17 # CNF(False Or (_x)) <-- CNF(x);
-18 # CNF((_x) Or True ) <-- True;
-19 # CNF((_x) Or False) <-- CNF(x);
-
-// A bit more complext
-21 # CNF(_x Or _x) <-- CNF(x);
-22 # CNF(_x And _x) <-- CNF(x);
-23 # CNF(_x Or Not (_x)) <-- True;
-14 # CNF(Not (_x) Or _x) <-- True;
-25 # CNF(_x And Not (_x)) <-- False;
-26 # CNF(Not (_x) And _x) <-- False;
-
-// Simplifications that deal with (in)equalities
-25 # CNF(((_x) == (_y)) Or ((_x) !== (_y))) <-- True;
-25 # CNF(((_x) !== (_y)) Or ((_x) == (_y))) <-- True;
-26 # CNF(((_x) == (_y)) And ((_x) !== (_y))) <-- False;
-26 # CNF(((_x) !== (_y)) And ((_x) == (_y))) <-- False;
-
-27 # CNF(((_x) >= (_y)) And ((_x) < (_y))) <-- False;
-27 # CNF(((_x) < (_y)) And ((_x) >= (_y))) <-- False;
-28 # CNF(((_x) >= (_y)) Or ((_x) < (_y))) <-- True;
-28 # CNF(((_x) < (_y)) Or ((_x) >= (_y))) <-- True;
-
-
-// some things that are more complex
-120 # CNF((_x) Or (_y)) <-- LogOr(x, y, CNF(x), CNF(y));
-10 # LogOr(_x,_y,_x,_y) <-- x Or y;
-20 # LogOr(_x,_y,_u,_v) <-- CNF(u Or v);
-
-130 # CNF( Not (_x)) <-- LogNot(x, CNF(x));
-10 # LogNot(_x, _x) <-- Not (x);
-20 # LogNot(_x, _y) <-- CNF(Not (y));
-
-40 # CNF( Not ( Not (_x))) <-- CNF(x); // eliminate double negation
-45 # CNF((_x)=>(_y)) <-- CNF((Not (x)) Or (y)); // eliminate implication
-
-50 # CNF( Not ((_x) And (_y))) <-- CNF((Not x) Or (Not y)); // De Morgan's law
-60 # CNF( Not ((_x) Or (_y))) <-- CNF(Not (x)) And CNF(Not (y)); // De Morgan's law
-
-/*
-70 # CNF((_x) And ((_y) Or (_z))) <-- CNF(x And y) Or CNF(x And z);
-70 # CNF(((_x) Or (_y)) And (_z)) <-- CNF(x And z) Or CNF(y And z);
-
-80 # CNF((_x) Or ((_y) And (_z))) <-- CNF(x Or y) And CNF(x Or z);
-80 # CNF(((_x) And (_y)) Or (_z)) <-- CNF(x Or z) And CNF(y Or z);
-*/
-
-70 # CNF(((_x) And (_y)) Or (_z)) <-- CNF(x Or z) And CNF(y Or z); // Distributing Or over And
-80 # CNF((_x) Or ((_y) And (_z))) <-- CNF(x Or y) And CNF(x Or z);
-
-90 # CNF((_x) And (_y)) <-- CNF(x) And CNF(y); // Transform subexpression
-
-101 # CNF( (_x) < (_y) ) <-- Not CNFInEq(x >= y);
-102 # CNF( (_x) > (_y) ) <-- CNFInEq(x > y);
-103 # CNF( (_x) >= (_y) ) <-- CNFInEq(x >= y);
-104 # CNF( (_x) <= (_y) ) <-- Not CNFInEq(x > y);
-105 # CNF( (_x) == (_y) ) <-- CNFInEq(x == y);
-106 # CNF( (_x) !== (_y) ) <-- Not CNFInEq(x == y);
-
-111 # CNF( Not((_x) < (_y)) ) <-- CNFInEq( x >= y );
-113 # CNF( Not((_x) <= (_y)) ) <-- CNFInEq( x > y );
-116 # CNF( Not((_x) !== (_y)) ) <-- CNFInEq( x == y );
-
-/* Accept as fully simplified, fallthrough case */
-200 # CNF(_x) <-- x;
-
-20 # CNFInEq((_xex) == (_yex)) <-- (CNFInEqSimplify(xex-yex) == 0);
-20 # CNFInEq((_xex) > (_yex)) <-- (CNFInEqSimplify(xex-yex) > 0);
-20 # CNFInEq((_xex) >= (_yex)) <-- (CNFInEqSimplify(xex-yex) >= 0);
-30 # CNFInEq(_exp) <-- (CNFInEqSimplify(exp));
-
-10 # CNFInEqSimplify((_x) - (_x)) <-- 0; // strictly speaking, this is not always valid, i.e. 1/0 - 1/0 != 0...
-100# CNFInEqSimplify(_x) <-- [/*Echo({"Hit the bottom of CNFInEqSimplify with ", x, Nl()});*/ x;];
- // former "Simplify";
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/Contradict.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/Contradict.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/Contradict.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/Contradict.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def="Contradict",scope="private"
-
-10 # Contradict((_x) - (_y) == 0, (_x) - (_z) == 0)_(y != z) <-- True;
-12 # Contradict((_x) == (_y), (_x) == (_z))_(y != z) <-- True;
-13 # Contradict((_x) - (_y) == 0, (_x) - (_z) >= 0)_(z > y) <-- True;
-14 # Contradict((_x) - (_y) == 0, (_x) - (_z) > 0)_(z > y) <-- True;
-14 # Contradict(Not (_x) - (_y) >= 0, (_x) - (_z) > 0)_(z > y) <-- True;
-15 # Contradict(_a, _b) <-- Equals(SimpleNegate(a), b);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/DoUnitSubsumptionAndResolution.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/DoUnitSubsumptionAndResolution.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/DoUnitSubsumptionAndResolution.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/DoUnitSubsumptionAndResolution.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-%mathpiper,def="DoUnitSubsumptionAndResolution",scope="private"
-
-// perform unit subsumption and resolutiuon for a unit clause # i
-// a boolean indicated whether there was a change is returned
-DoUnitSubsumptionAndResolution(_list) <--
-[
- Local(i, j, k, isFalse, isTrue, changed);
- Set(isFalse, False);
- Set(isTrue, False);
- Set(changed, True);
-
- //Echo({"In DoUnitSubsumptionAndResolution", Nl()});
-
- While(changed) [
- Set(changed, False);
-
- For(i:=1, (Not isFalse And Not isTrue) And i <= Length(list), i++)
- [
- If(Length(list[i]) = 1, [
- Local(x); Set(x, list[i][1]); //n := SimpleNegate(x);
- //Echo({"Unit clause ", x, Nl()});
-
- // found a unit clause, {x}, not use it to modify other clauses
- For(j:=1, (Not isFalse And Not isTrue) And j <= Length(list), j++)
- [
- If(i !=j, [
- Local(deletedClause); Set(deletedClause, False);
- For(k:=1, (Not isFalse And Not isTrue And Not deletedClause) And k <= Length(list[j]), k++)
- [
- // In both of these, if a clause becomes empty, the whole thing is False
-
- //Echo({" ", x, " subsumes ", list[j][k], i,j, Subsumes(x, list[j][k]), Nl()});
-
- // unit subsumption -- this kills clause j
- If(Subsumes(x, list[j][k]), [
- // delete this clause
- DestructiveDelete(list, j);
- j--;
- If(i>j, i--); // i also needs to be decremented
- Set(deletedClause, True);
- Set(changed, True);
- If(Length(list) = 0, [Set(isTrue, True);]);
- ],
- // else, try unit resolution
- If(Contradict(x, list[j][k]), [
- //Echo({x, " contradicts", list[j][k], Nl()});
- DestructiveDelete(list[j], k);
- k--;
- Set(changed, True);
- If(Length(list[j]) = 0, [Set(isFalse, True);]);
- ])
- );
- ];
- ]);
- ];
- ]);
- ];
- ];
-
- list;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/equals_greaterthan_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/equals_greaterthan_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/equals_greaterthan_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/equals_greaterthan_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="=>"
-
-RuleBase("=>",{a,b});
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicCombine.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicCombine.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicCombine.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicCombine.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="LogicCombine",scope="private"
-
-/* LogicCombine is responsible for scanning a list of lists, which represent
- a form (p1 Or p2 Or ...) And (q1 Or q2 Or ...) And ... by scanning the lists
- for combinations x Or Y And Not x Or Z <-- Y Or Z . If Y Or Z is empty then this clause
- is false, and thus the entire proposition is false.
-*/
-LogicCombine(_list) <--
-[
- Local(i, j);
- For(Set(i,1), i<=Length(list), Set(i,AddN(i,1)))
- [
- //Echo({"list[", i, "/", Length(list), "]: ", list[i], Nl()});
-
- For(j := 1, (j<=Length(list[i])), j++)
- [
- Local(tocombine, n, k);
- Set(n, list[i][j]);
-
- {tocombine, k} := LogicFindWith(list, i, n);// search forward for n, tocombine is the list we
- // will combine the current one with
- If(tocombine != -1,
- [
- Local(combination);
- Check(k != -1, "k is -1");
-
- Set(combination, LogicRemoveTautologies(Concat(list[i], list[tocombine])));
- If(combination = {}, // the combined clause is false, so the whole thing is false
- [Set(list, {{}}); Set(i, Length(list)+1);], [/*Set(i, 0);*/]);
- ]);
- ];
- ];
- list;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicFindWith.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicFindWith.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicFindWith.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicFindWith.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-%mathpiper,def="LogicFindWith",scope="private"
-
-/* find the number of the list that contains n in it, a pointer to a list of lists in passed */
-LogicFindWith(_list, _i, _n) <--
-[
- Local(result, index, j);
- Set(result, -1); Set(index, -1);
-
- For(j := i+1, (result<0) And (j <= Length(list)), j++)
- [
- Local(k, len); Set(len, Length(list[j]));
- For(k := 1, (result<0) And (k<=len), k++)
- [
- Local(el); Set(el, list[j][k]);
-
- If(Contradict(n, el),
- [Set(result, j); Set(index, k);]);
- ];
- ];
- {result, index};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicRemoveTautologies.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicRemoveTautologies.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicRemoveTautologies.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicRemoveTautologies.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,66 +0,0 @@
-%mathpiper,def="LogicRemoveTautologies",scope="private"
-
- // not clear is this will stay, but it is eq. to LogicSimplify(expr, 2)
-
-1 # SimpleNegate(Not (_x)) <-- x;
-2 # SimpleNegate(_x) <-- Not(x);
-
-/* LogicRemoveTautologies scans a list representing e1 Or e2 Or ... to find
- if there are elements p and Not p in the list. This signifies p Or Not p,
- which is always True. These pairs are removed. Another function that is used
- is RemoveDuplicates, which converts p Or p into p.
-*/
-
-/* this can be optimized to walk through the lists a bit more efficiently and also take
-care of duplicates in one pass */
-LocalCmp(_e1, _e2) <-- LessThan(ToString() Write(e1), ToString() Write(e2));
-
-// we may want to add other expression simplifers for new expression types
-100 # SimplifyExpression(_x) <-- x;
-
-// Return values:
-// {True} means True
-// {} means False
-LogicRemoveTautologies(_e) <--
-[
- Local(i, len, negationfound); Set(len, Length(e));
- Set(negationfound, False);
-
- //Echo(e);
- e := BubbleSort(e, "LocalCmp");
-
- For(Set(i, 1), (i <= len) And (Not negationfound), i++)
- [
- Local(x, n, j);
- // we can register other simplification rules for expressions
- //e[i] := MathNth(e,i) /:: {gamma(_y) <- SimplifyExpression(gamma(y))};
- Set(x, MathNth(e,i));
- Set(n, SimpleNegate(x)); /* this is all we have to do because of
- the kind of expressions we can have coming in */
-
- For(Set(j, i+1), (j <= len) And (Not negationfound), j++) [
- Local(y);
- Set(y, MathNth(e,j));
-
- If(Equals(y, n),
- [
- //Echo({"Deleting from ", e, " i=", i, ", j=", j, Nl()});
-
- Set(negationfound, True);
- //Echo({"Removing clause ", i, Nl()});
- ],
- If(Equals(y, x),
- [
- //Echo({"Deleting from ", e, " j=", j, Nl()});
- DestructiveDelete(e, j);
- Set(len,SubtractN(len,1));
- ])
- );
- ];
- Check(len = Length(e), "The length computation is incorrect");
- ];
-
- If(negationfound, {True}, e); /* note that a list is returned */
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicSimplify.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicSimplify.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/LogicSimplify.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/LogicSimplify.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="LogicSimplify"
-
- // (expression, level=1..3
-
-// Some shortcuts to match prev interface
-
-10 # LogicSimplify(_proposition, _level)_(level<2) <-- CNF(proposition);
-
-20 # LogicSimplify(_proposition, _level) <--
-[
- Local(cnf, list, clauses);
- Check(level > 1, "Wrong level");
- // First get the CNF version of the proposition
- Set(cnf, CNF(proposition));
-
- If(level <= 1, cnf, [
- Set(list, Flatten(cnf, "And"));
- Set(clauses, {});
- ForEach(clause, list)
- [
- Local(newclause);
- //newclause := BubbleSort(LogicRemoveTautologies(Flatten(clause, "Or")), LessThan);
- Set(newclause, LogicRemoveTautologies(Flatten(clause, "Or")));
- If(newclause != {True}, DestructiveAppend(clauses, newclause));
- ];
-
- /*
- Note that we sort each of the clauses so that they look the same,
- i.e. if we have (A And B) And ( B And A), only the first one will
- persist.
- */
- Set(clauses, RemoveDuplicates(clauses));
-
- If(Equals(level, 3) And (Length(clauses) != 0), [
- Set(clauses, DoUnitSubsumptionAndResolution(clauses));
- Set(clauses, LogicCombine(clauses));
- ]);
-
- Set(clauses, RemoveDuplicates(clauses));
-
- If(Equals(Length(clauses), 0), True, [
- /* assemble the result back into a boolean expression */
- Local(result);
- Set(result, True);
- ForEach(item,clauses)
- [
- Set(result, result And UnFlatten(item, "Or", False));
- ];
-
- result;
- ]);
- ]);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,16 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef( "=>" , "logic1","implies" );
-OMDef( "CNF" , mathpiper,"cnf" );
-OMDef( "LogicSimplify", mathpiper,"logic_simplify" );
-OMDef( "CanProve" , mathpiper,"can_prove" );
-OMDef( "LogicRemoveTautologies", mathpiper,"logic_remove_tautologies" );
-OMDef( "Subsumes" , mathpiper,"subsumes" );
-// The following appear in the def file, but commented out:
-// "~", mathpiper, "Not"
-// "|", mathpiper, "Or"
-// "&", mathpiper, "And"
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/Subsumes.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/Subsumes.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/logic/Subsumes.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/logic/Subsumes.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,15 +0,0 @@
-%mathpiper,def="Subsumes"
-
-10 # Subsumes((_x) - (_y) == 0, Not ((_x) - (_z)==0))_(y!=z) <-- True;
-// suif_tmp0_127_1-72==0 And 78-suif_tmp0_127_1>=0
-20 # Subsumes((_x) - (_y) == 0, (_z) - (_x) >= 0)_(z>=y) <-- True;
-20 # Subsumes((_x) - (_y) == 0, (_z) - (_x) > 0)_(z>y) <-- True;
-// suif_tmp0_127_1-72==0 And suif_tmp0_127_1-63>=0
-30 # Subsumes((_x) - (_y) == 0, (_x) - (_z) >= 0)_(y>=z) <-- True;
-30 # Subsumes((_x) - (_y) == 0, (_x) - (_z) > 0)_(y>z) <-- True;
-
-90 # Subsumes((_x), (_x)) <-- True;
-
-100# Subsumes((_x), (_y)) <-- False;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/Groebner.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/Groebner.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/Groebner.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/Groebner.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="Groebner"
-
-/*
- Groebner : Calculate the Groebner basis of a set of polynomials.
- Nice example of its power is
-
-In> TableForm(Groebner({x*(y-1),y*(x-1)}))
- x*y-x
- x*y-y
- y-x
- y^2-y
-In> Factor(y^2-y)
-Out> y*(y-1);
-
-From which you can see that x = y, and x^2 = x so x is 0 or 1.
-
-*/
-
-Groebner(f_IsList) <--
-[
- Local(vars,i,j,S,nr,r);
- nr:=Length(f);
- vars:=VarList(f);
- For(i:=1,i<=nr,i++)
- [
- f[i] := MakeMultiNomial(f[i],vars);
- ];
- S:={};
- For(i:=1,i0)
- [
- If(n&1 != 0, Set(result, MultiNomialMultiply(result,mult)));
- Set(n,n>>1);
- If(n!=0,Set(mult,MultiNomialMultiply(mult,mult)));
- ];
- result;
- ];
-
- 15 # MakeMultiNomial(_x ^ _n,vars_IsList)_(Not(IsInteger(n)) And IsInteger(Simplify(n))) <--
- MakeMultiNomial( x ^ Simplify(n),vars);
-
- 50 # MakeMultiNomial(_x ^ (_n),vars_IsList)_(Contains(vars,x)) <--
- [
- Set(n,Simplify(n));
- If(IsInteger(n),
- MultiSingleFactor(vars,x,n),
- MultiSingleFactor(vars,x^n,1)
- );
- ];
-];
-
-
-x_IsMulti + (y_IsMulti/z_IsMulti) <-- ((x*z+y)/z);
-(y_IsMulti/z_IsMulti) + x_IsMulti <-- ((x*z+y)/z);
-(y_IsMulti/z_IsMulti) + (x_IsMulti/w_IsMulti) <-- ((y*w+x*z)/(z*w));
-(y_IsMulti/z_IsMulti) - (x_IsMulti/w_IsMulti) <-- ((y*w-x*z)/(z*w));
-(y_IsMulti/z_IsMulti) * (x_IsMulti/w_IsMulti) <-- ((y*x)/(z*w));
-(y_IsMulti/z_IsMulti) / (x_IsMulti/w_IsMulti) <-- ((y*w)/(z*x));
-x_IsMulti - (y_IsMulti/z_IsMulti) <-- ((x*z-y)/z);
-(y_IsMulti/z_IsMulti) - x_IsMulti <-- ((y-x*z)/z);
-(a_IsMulti/(c_IsMulti/b_IsMulti)) <-- ((a*b)/c);
-((a_IsMulti/c_IsMulti)/b_IsMulti) <-- (a/(b*c));
-((a_IsMulti/b_IsMulti) * c_IsMulti) <-- ((a*c)/b);
-(a_IsMulti * (c_IsMulti/b_IsMulti)) <-- ((a*c)/b);
-- ((a_IsMulti)/(b_IsMulti)) <-- (-a)/b;
-
-
-MultiNomialMultiply(
- MultiNomial(_vars,_terms1)/MultiNomial(_vars,_terms2),
- MultiNomial(_vars,_terms3)/MultiNomial(_vars,_terms4)) <--
-[
- MultiNomialMultiply(MultiNomial(vars,terms1),MultiNomial(vars,terms3))/
- MultiNomialMultiply(MultiNomial(vars,terms2),MultiNomial(vars,terms4));
-];
-MultiNomialMultiply(
- MultiNomial(_vars,_terms1)/MultiNomial(_vars,_terms2),
- MultiNomial(_vars,_terms3)) <--
-[
- MultiNomialMultiply(MultiNomial(vars,terms1),MultiNomial(vars,terms3))/
- MultiNomial(vars,terms2);
-];
-MultiNomialMultiply(
- MultiNomial(_vars,_terms3),
- MultiNomial(_vars,_terms1)/MultiNomial(_vars,_terms2)) <--
-[
- MultiNomialMultiply(MultiNomial(vars,terms1),MultiNomial(vars,terms3))/
- MultiNomial(vars,terms2);
-];
-
-10 # MultiNomialMultiply(_a,_b) <--
-[
- Echo({"ERROR!",a,b});
- Echo({"ERROR!",Type(a),Type(b)});
-];
-
-
-
-
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MM.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MM.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MM.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MM.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-%mathpiper,def="MM"
-
-MM(_expr) <-- MM(expr,MultiExpressionList(expr));
-MM(_expr,_vars) <-- MakeMultiNomial(expr,vars);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiDivide.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiDivide.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiDivide.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiDivide.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,80 +0,0 @@
-%mathpiper,def="MultiDivide"
-
-/*************************************************************
- MultiDivide :
- input
- f - a multivariate polynomial
- g[1 .. n] - a list of polynomials to divide by
- output
- {q[1 .. n],r} such that f = q[1]*g[1] + ... + q[n]*g[n] + r
-
- Basically quotient and remainder after division by a group of
- polynomials.
-**************************************************************/
-20 # MultiDivide(_f,g_IsList) <--
-[
- Local(i,v,q,r,nr);
- v:=MultiExpressionList(f+Sum(g));
- f:=MakeMultiNomial(f,v);
- nr := Length(g);
- For(i:=1,i<=nr,i++)
- [
- g[i] := MakeMultiNomial(g[i],v);
- ];
- {q,r}:=MultiDivide(f,g);
- q:=MapSingle("NormalForm",q);
- r:=NormalForm(r);
- {q,r};
-];
-
-10 # MultiDivide(f_IsMulti,g_IsList) <--
-[
- Local(i,nr,q,r,p,v,finished);
- Set(nr, Length(g));
- Set(v, MultiVars(f));
- Set(q, FillList(0,nr));
- Set(r, 0);
- Set(p, f);
- Set(finished,MultiZero(p));
- Local(plt,glt);
- While (Not finished)
- [
- Set(plt, MultiLT(p));
- For(i:=1,i<=nr,i++)
- [
- Set(glt, MultiLT(g[i]));
-
- if (MultiLM(glt) = MultiLM(plt) Or MultiTermLess({MultiLM(glt),1}, {MultiLM(plt),1}))
- if (Select({{n},n<0},MultiLM(plt)-MultiLM(glt)) = {})
- [
- Local(ff);
- Set(ff, CreateTerm(v,{MultiLM(plt)-MultiLM(glt),MultiLC(plt)/MultiLC(glt)}));
- q[i] := q[i] + ff;
- Local(ltbefore,ltafter);
- Set(ltbefore,MultiLeadingTerm(p));
-// Echo(ltbefore,MultiLeadingTerm(p));
- Set(p, p - ff*g[i]);
- Set(ltafter,MultiLeadingTerm(p));
-// Echo(ltbefore,MultiLeadingTerm(p));
- if (ltbefore[1] = ltafter[1])
- [
- Set(ltafter,MultiLT(p));
- Set(p,p-ltafter);
- ];
-// Echo(ltbefore,MultiLeadingTerm(p));
- Set(i,nr+2);
- ];
- ];
-
- If (i = nr+1,
- [
- Set(r, r + LocalSymbols(a,b)(Subst(a,b)plt));
- Set(p, p - LocalSymbols(a,b)(Subst(a,b)plt));
- ]);
-//Echo(p);
- Set(finished,MultiZero(p));
- ];
- {q,r};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiDivTerm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiDivTerm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiDivTerm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiDivTerm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,25 +0,0 @@
-%mathpiper,def="MultiDivTerm",scope="private"
-
-MultiDivTerm(MultiNomial(_vars,_term1),MultiNomial(_vars,_term2)) <--
-[
- Local(lm1,lm2);
- Set(lm1,MultiLeadingTerm(MultiNomial(vars,term1)) );
- Set(lm2,MultiLeadingTerm(MultiNomial(vars,term2)) );
- CreateTerm(vars,{lm1[1]-lm2[1],lm1[2] / lm2[2]});
-];
-MultiS(_g,_h,MultiNomial(_vars,_terms)) <--
-[
- Local(gamma);
-
- gamma :=Max(MultiDegree(g),MultiDegree(h));
- Local(result,topterm);
- topterm := MM(Product(vars^gamma));
-
- result :=
- MultiDivTerm(topterm,MultiLT(g))*g -
- MultiDivTerm(topterm,MultiLT(h))*h;
-
- result;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiGcd.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiGcd.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiGcd.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiGcd.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,60 +0,0 @@
-%mathpiper,def="MultiGcd"
-
-//TODO optimize this! keeps on converting to and from internal format!
-
-10 # MultiGcd( 0,_g) <-- g;
-10 # MultiGcd(_f, 0) <-- f;
-
-20 # MultiGcd(_f,_g) <--
-[
- Local(v);
- v:=MultiExpressionList(f+g); //hier
- NormalForm(MultiGcd(MakeMultiNomial(f,v),MakeMultiNomial(g,v)));
-];
-
-
-5 # MultiGcd(f_IsMulti,g_IsMulti)_(MultiTermLess({MultiLM(f),1},{MultiLM(g),1})) <--
-[
-//Echo("lesser");
- MultiGcd(g,f);
-];
-
-5 # MultiGcd(MultiNomial(_vars,_terms),g_IsMulti)_(MultiLM(MultiNomial(vars,terms)) = MultiLM(g))
- <-- CreateTerm(vars,{FillList(0,Length(vars)),1});
-
-5 # MultiGcd(MultiNomial(_vars,_terms),g_IsMulti)_(Select({{n},n<0},MultiLM(MultiNomial(vars,terms))-MultiLM(g)) != {})
- <-- CreateTerm(vars,{FillList(0,Length(vars)),1});
-
-5 # MultiGcd(MultiNomial(_vars,_terms),g_IsMulti)_(NormalForm(g) = 0)
- <-- CreateTerm(vars,{FillList(0,Length(vars)),1});
-10 # MultiGcd(f_IsMulti,g_IsMulti) <--
-[
- LocalSymbols(a)
- [
- Set(f,Subst(a,a)f);
- Set(g,Subst(a,a)g);
- ];
- Local(new);
- While(g != 0)
- [
-//Echo("before f",f,NormalForm(f));
-//Echo("before g",g,NormalForm(g));
- Set(new, MultiDivide(f,{g}));
-//Echo("new g",NormalForm(new[1][1]),NormalForm(new[2]));
-If(new[1][1]=0,
-[
- g:=MakeMultiNomial(1,MultiVars(f));
-//Echo("PRIM ",MultiPrimitivePart(g));
- new[2]:=0;
-]);
- Set(new, new[2]);
- Set(f,g);
- Set(g,new);
-
-//Echo("after f",f,NormalForm(f));
-//Echo("after g",g,NormalForm(g));
- ];
- MultiPrimitivePart(f);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiNomial.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiNomial.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiNomial.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiNomial.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-%mathpiper,def="MultiNomial"
-
-// The basic container for multivariates
-RuleBase("MultiNomial",{vars,terms});
-
-// using the sparse tree driver for multivariate polynomials
-//Use("org/mathpiper/assembledscripts/multivar.rep/sparsenomial.mpi");
-//Use("org/mathpiper/assembledscripts/multivar.rep/partialdensenomial.mpi");
-
-If(IsBound(MultiNomialDriver),
- `Use(@MultiNomialDriver),
- Use("org/mathpiper/assembledscripts/multivar.rep/sparsenomial.mpi"));
-
-// Code that can build the internal representation of a multivariate polynomial
-Use("org/mathpiper/assembledscripts/multivar.rep/makemulti.mpi");
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiSimp.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiSimp.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/MultiSimp.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/MultiSimp.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,114 +0,0 @@
-%mathpiper,def="MultiSimp"
-
-MultiSimp(_expr) <--
-[
- Local(vars);
- vars:=MultiExpressionList(expr);
-//Echo({"step1 ",MM(expr,vars)});
- MultiSimp2(MM(expr,vars));
-];
-
-10 # MultiSimp2(_a / _b) <--
-[
- Local(c1,c2,gcd,cmn,vars);
-
-
- c1 := MultiContentTerm(a);
- c2 := MultiContentTerm(b);
- gcd:=Gcd(c1[2],c2[2]);
- c1[2] := c1[2]/gcd;
- c2[2] := c2[2]/gcd;
-
- cmn:=Min(c1[1],c2[1]);
- c1[1] := c1[1] - cmn;
- c2[1] := c2[1] - cmn;
-
- vars:=MultiVars(a);
- Check(vars = MultiVars(a),"incompatible Multivars to simplify");
-
- (NormalForm(CreateTerm(vars,c1))/NormalForm(CreateTerm(vars,c2)))
- *(NormalForm(MultiPrimitivePart(a))/NormalForm(MultiPrimitivePart(b)));
-];
-
-20 # MultiSimp2(expr_IsMulti) <--
-[
- NormalForm(MultiContent(expr))*NormalForm(MultiPrimitivePart(expr));
-];
-30 # MultiSimp2(_expr) <-- expr;
-
-MultiContent(multi_IsMulti)
-<--
-[
- Local(least,gcd);
- Set(least, MultiDegree(multi));
- Set(gcd,MultiLeadingCoef(multi));
- ScanMultiNomial("MultiContentScan",multi);
- CreateTerm(MultiVars(multi),MultiContentTerm(multi));
-];
-
-MultiContentTerm(multi_IsMulti)
-<--
-[
- Local(least,gcd);
- Set(least, MultiDegree(multi));
- Set(gcd,MultiLeadingCoef(multi));
- ScanMultiNomial("MultiContentScan",multi);
- {least,gcd};
-];
-
-MultiContentScan(_coefs,_fact) <--
-[
- Set(least,Min({least,coefs}));
- Set(gcd,Gcd(gcd,fact));
-];
-UnFence("MultiContentScan",2);
-
-MultiPrimitivePart(MultiNomial(vars_IsList,_terms))
-<--
-[
- Local(cont);
- Set(cont,MultiContentTerm(MultiNomial(vars,terms)));
- Set(cont,CreateTerm(vars,{-cont[1],1/(cont[2])}));
- MultiNomialMultiply(MultiNomial(vars,terms), cont);
-];
-
-10 # MultiRemoveGcd(x_IsMulti/y_IsMulti) <--
-[
- Local(gcd);
- Set(gcd,MultiGcd(x,y));
- Set(x,MultiDivide(x,{gcd})[1][1]);
- Set(y,MultiDivide(y,{gcd})[1][1]);
- x/y;
-];
-20 # MultiRemoveGcd(_x) <-- x;
-
-
-
-5 # MultiDegree(MultiNomial(_vars,_term))_(Not(IsList(term))) <-- {};
-10 # MultiDegree(MultiNomial(_vars,{})) <-- FillList(-Infinity,Length(vars));
-20 # MultiDegree(MultiNomial(_vars,_terms))
- <-- (MultiLeadingTerm(MultiNomial(vars,terms))[1]);
-
-
-10 # MultiLeadingCoef(MultiNomial(_vars,_terms))
- <-- (MultiLeadingTerm(MultiNomial(vars,terms))[2]);
-
-10 # MultiLeadingMono(MultiNomial(_vars,{})) <-- 0;
-20 # MultiLeadingMono(MultiNomial(_vars,_terms))
- <-- Product(vars^(MultiDegree(MultiNomial(vars,terms))));
-
-20 # MultiLeadingTerm(_m) <-- MultiLeadingCoef(m) * MultiLeadingMono(m);
-
-MultiVars(MultiNomial(_vars,_terms)) <-- vars;
-
-20 # MultiLT(multi_IsMulti)
- <-- CreateTerm(MultiVars(multi),MultiLeadingTerm(multi));
-
-10 # MultiLM(multi_IsMulti) <-- MultiDegree(multi);
-
-10 # MultiLC(MultiNomial(_vars,{})) <-- 0;
-20 # MultiLC(multi_IsMulti) <-- MultiLeadingCoef(multi);
-
-DropZeroLC(multi_IsMulti) <-- MultiDropLeadingZeroes(multi);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/sparsenomial/sparsenomial.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/sparsenomial/sparsenomial.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/sparsenomial/sparsenomial.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/sparsenomial/sparsenomial.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,152 +0,0 @@
-%mathpiper,def=""
-
-
-/* Implementation of MultiNomials based on sparse representation
- in the sparsetree.mpi code. This is the real driver, using
- the sparse trees just for representation.
- */
-Use("org/mathpiper/assembledscripts/multivar.rep/sparsetree.mpi");
-
-LocalSymbols(NormalMultiNomial) [
-
-CreateTerm(_vars,{_coefs,_fact})
- <-- MultiNomial(vars,CreateSparseTree(coefs,fact));
-
-/************************************************************
-
-Adding and multiplying multivariate polynomials
-
-************************************************************/
-MultiNomialAdd(MultiNomial(_vars,_x), MultiNomial(_vars,_y))
- <-- MultiNomial(vars,AddSparseTrees(Length(vars),x,y));
-MultiNomialMultiplyAdd(MultiNomial(_vars,_x), MultiNomial(_vars,_y),_coefs,_fact)
- <-- MultiNomial(vars,MultiplyAddSparseTrees(Length(vars),x,y,coefs,fact));
-MultiNomialNegate(MultiNomial(_vars,_terms))
- <--
- [
- SparseTreeMap(Hold({{coefs,list},-list}),Length(vars),terms);
- MultiNomial(vars,terms);
- ];
-MultiNomialMultiply(MultiNomial(_vars,_x),_multi2)
- <--
- [
- Local(result);
- Set(result,MakeMultiNomial(0,vars));
- SparseTreeScan("muadm",Length(vars),x);
- result;
- ];
-muadm(_coefs,_fact) <--
-[
- Set(result,MultiNomialMultiplyAdd(result, multi2,coefs,fact));
-];
-UnFence("muadm",2);
-
-
-/* NormalForm: done as an explicit loop in stead of using SparseTreeScan
- for speed. This routine is a lot faster!
- */
-10 # NormalForm(x_IsMulti/y_IsMulti) <-- NormalForm(x)/NormalForm(y);
-20 # NormalForm(MultiNomial(_vars,_list) )
- <-- NormalMultiNomial(vars,list,1);
-10 # NormalMultiNomial({},_term,_prefact) <-- prefact*term;
-20 # NormalMultiNomial(_vars,_list,_prefact)
- <--
- [
- Local(first,rest,result);
- Set(first,First(vars));
- Set(rest,Rest(vars));
- Set(result,0);
- ForEach(item,list)
- [
- Set(result,result+NormalMultiNomial(rest,item[2],prefact*first^(item[1])));
- ];
- result;
- ];
-
-]; // LocalSymbols
-
-MultiLeadingTerm(MultiNomial(_vars,_terms))
- <--
- [
- Local(coefs,fact);
- Set(coefs,MultiDegreeScanHead(terms,Length(vars)));
- {coefs,fact};
- ];
-10 # MultiDegreeScanHead(_tree,0)
- <--
- [
- Set(fact,tree);
- {};
- ];
-10 # MultiDegreeScanHead(_tree,1)
- <--
- [
- Set(fact,tree[1][2]);
- {tree[1][1]};
- ];
-20 # MultiDegreeScanHead(_tree,_depth)
- <--
- [
- (tree[1][1]):MultiDegreeScanHead(tree[1][2],depth-1);
- ];
-UnFence("MultiDegreeScanHead",2);
-
-ScanMultiNomial(_op,MultiNomial(vars_IsList,_terms))
- <-- SparseTreeScan(op,Length(vars),terms);
-UnFence("ScanMultiNomial",2);
-
-
-MultiDropLeadingZeroes(MultiNomial(_vars,_terms))
- <--
- [
- MultiDropScan(terms,Length(vars));
- MultiNomial(vars,terms);
- ];
-10 # MultiDropScan(0,0) <-- True;
-10 # MultiDropScan({_n,0},0) <-- True;
-20 # MultiDropScan(_n,0)
- <--
- [
- False;
- ];
-30 # MultiDropScan(_tree,_depth)
- <--
- [
- Local(i);
- For(i:=1,i<=Length(tree),i++)
- [
- if (MultiDropScan(tree[i][2],depth-1))
- [
- DestructiveDelete(tree,i);
- i--;
- ]
- else
- [
- i:=Length(tree);
- ];
- ];
- (tree = {});
- ];
-UnFence("MultiDropScan",2);
-
-
-MultiTermLess({_deg1,_fact1},{_deg2,_fact2}) <--
- [
- Local(deg);
- Set(deg, deg1-deg2);
- While(deg != {} And First(deg) = 0) [ Set(deg, Rest(deg));];
-
- ((deg = {}) And (fact1-fact2 < 0)) Or
- ((deg != {}) And (deg[1] < 0));
- ];
-
-20 # MultiZero(multi_IsMulti) <--
-[
- CheckMultiZero(DropZeroLC(multi));
-];
-10 # CheckMultiZero(MultiNomial(_vars,{})) <-- True;
-20 # CheckMultiZero(MultiNomial(_vars,_terms)) <-- False;
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/sparsetree/sparsetree.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/sparsetree/sparsetree.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/multivar/sparsetree/sparsetree.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/multivar/sparsetree/sparsetree.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,220 +0,0 @@
-%mathpiper,def="CreateSparseTree;SparseTreeMap;SparseTreeScan;AddSparseTrees;MultiplyAddSparseTrees;SparseTreeGet"
-
-/* def file definitions
-CreateSparseTree
-SparseTreeMap
-SparseTreeScan
-AddSparseTrees
-MultiplyAddSparseTrees
-SparseTreeGet
-*/
-
-/* Implementation of a sparse tree of Multidimensional matrix elements.
-*/
-
-10 # SparseTreeGet({},_tree) <-- tree;
-20 # SparseTreeGet(_key,_tree) <--
-[
- SparseTreeGet2(Rest(key),Assoc(First(key),tree));
-];
-10 # SparseTreeGet2(_key,Empty) <-- 0;
-20 # SparseTreeGet2(_key,_item) <-- SparseTreeGet(key,First(Rest(item)));
-
-10 # SparseTreeSet({_i},_tree,_newvalue)
- <--
-[
- Local(Current,assoc,result);
- Set(assoc,Assoc(i,tree));
- if(assoc=Empty)
- [
- Set(Current,0);
- Set(result,Eval(newvalue));
- AddSparseTrees(1,tree,CreateSparseTree({i},result));
- ]
- else
- [
- Set(Current,assoc[2]);
- Set(result,Eval(newvalue));
- assoc[2] := result;
- ];
- result;
-];
-20 # SparseTreeSet(_key,_tree,_newvalue) <--
-[
- SparseTreeSet2(Rest(key),Assoc(First(key),tree));
-];
-10 # SparseTreeSet2(_key,Empty) <-- 0;
-20 # SparseTreeSet2(_key,_item)
- <-- SparseTreeSet(key,First(Rest(item)),newvalue);
-UnFence("SparseTreeSet",3);
-UnFence("SparseTreeSet2",2);
-
-
-LocalSymbols(SparseTreeMap2,SparseTreeScan2,Muaddterm,MuMuaddterm,
- meradd,meraddmap) [
-
-10 # CreateSparseTree({},_fact) <-- fact;
-
-20 # CreateSparseTree(_coefs,_fact)
- <-- CreateSparseTree(First(coefs),Rest(coefs),fact);
-10 # CreateSparseTree(_first,{},_fact) <-- {{first,fact}};
-20 # CreateSparseTree(_first,_coefs,_fact)
- <-- {{first,CreateSparseTree(First(coefs),Rest(coefs),fact)}};
-
-10 # SparseTreeMap(_op,_depth,_list) <-- SparseTreeMap2(list,depth,{});
-10 # SparseTreeMap2(_list,1,_coefs)
- <--
- ForEach(item,list)
- [
- item[2] := ApplyPure(op,{Concat(coefs,{item[1]}),item[2]});
- ];
-20 # SparseTreeMap2(_list,_depth,_coefs)
- <--
- ForEach(item,list)
- [
- SparseTreeMap2(item[2],AddN(depth,-1),Concat(coefs,{item[1]}));
- ];
-UnFence("SparseTreeMap", 3);
-[Local(fn);fn:=String(SparseTreeMap2);`UnFence(@fn,3);];
-
-10 # SparseTreeScan(_op,_depth,_list) <-- SparseTreeScan2(list,depth,{});
-10 # SparseTreeScan2(_list,0,_coefs) <-- ApplyPure(op,{coefs,list});
-20 # SparseTreeScan2(_list,_depth,_coefs)
- <--
- ForEach(item,list)
- [
- SparseTreeScan2(item[2],AddN(depth,-1),Concat(coefs,{item[1]}));
- ];
-UnFence("SparseTreeScan", 3);
-[Local(fn);fn:=String(SparseTreeScan2);`UnFence(@fn,3);];
-
-
-
-5 # AddSparseTrees(0,_x,_y) <-- x+y;
-10 # AddSparseTrees(_depth,_x,_y) <--
-[
- Local(i,t1,t2,inspt);
- Set(t1,x);
- Set(i,1);
- Set(t2,y);
- Set(inspt,{});
- While(t1 != {} And t2 != {})
- [
- Muaddterm(First(t1),First(t2));
- ];
- While(t2 != {})
- [
- Set(x,DestructiveAppend(x,First(t2)));
- Set(t2,Rest(t2));
- ];
- While(inspt != {})
- [
- Set(i,First(inspt));
- Set(x,DestructiveInsert(x,i[2],i[1]));
- Set(inspt,Rest(inspt));
- ];
- x;
-];
-
-10 # Muaddterm({_pow,_list1},{_pow,_list2}) <--
-[
- if(depth=1)
- [ t1[1][2] := list1+list2; ]
- else
- [ t1[1][2] := AddSparseTrees(AddN(depth,-1),list1,list2);];
- Set(t2,Rest(t2));
-];
-20 # Muaddterm(_h1,_h2)_(h1[1] Abs(N(Eval(eps*r)) ) ) )
- [
- r2 := r1;
- n++;
- r1 := ContFracEval(Take(cflist,n));
- ];
- // now r1 and r2 are some rational numbers.
- // decide whether the search was successful.
- If(
- n=Length(cflist),
- {}, // return empty list if not enough precision
- If(N(Eval(r-r1))>0,
- {r1, r2}, // successive approximations are always bracketing, we only need to decide their order
- {r2, r1}
- )
- );
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="BracketRational",categories="User Functions;Numbers (Operations)"
-*CMD BracketRational --- find optimal rational approximations
-*STD
-*CALL
- BracketRational(x, eps)
-
-*PARMS
-
-{x} -- a number to be approximated (must be already evaluated to floating-point)
-
-{eps} -- desired precision
-
-*DESC
-
-The function {BracketRational(x,eps)} can be used to find approximations with a given relative precision from above and from below.
-This function returns a list of two rational numbers {{r1,r2}} such that $r1 BracketRational(N(Ln(10)), 10^(-8))
- Out> {12381/5377,41062/17833};
-
-
-*SEE GuessRational, NearRational, ContFrac, ContFracList, Rationalize
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/CharacteristicEquation.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/CharacteristicEquation.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/CharacteristicEquation.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/CharacteristicEquation.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,40 +0,0 @@
-%mathpiper,def="CharacteristicEquation"
-
-Function("CharacteristicEquation",{matrix,var})
- SymbolicDeterminant(matrix-var*Identity(Length(matrix)));
-HoldArg("CharacteristicEquation",var);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="CharacteristicEquation",categories="User Functions;Linear Algebra"
-*CMD CharacteristicEquation --- get characteristic polynomial of a matrix
-*STD
-*CALL
- CharacteristicEquation(matrix,var)
-
-*PARMS
-
-{matrix} -- a matrix
-
-{var} -- a free variable
-
-*DESC
-
-CharacteristicEquation
-returns the characteristic equation of "matrix", using
-"var". The zeros of this equation are the eigenvalues
-of the matrix, Det(matrix-I*var);
-
-*E.G.
-
- In> A:=DiagonalMatrix({a,b,c})
- Out> {{a,0,0},{0,b,0},{0,0,c}};
- In> B:=CharacteristicEquation(A,x)
- Out> (a-x)*(b-x)*(c-x);
- In> Expand(B,x)
- Out> (b+a+c)*x^2-x^3-((b+a)*c+a*b)*x+a*b*c;
-
-*SEE EigenValues, EigenVectors
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFracEval.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFracEval.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFracEval.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFracEval.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-%mathpiper,def="ContFracEval"
-
-//////////////////////////////////////////////////
-/// ContFracEval: evaluate continued fraction from the list of coefficients
-//////////////////////////////////////////////////
-/// Each coefficient is either a single expression or a list of 2 expressions, giving the term and the numerator of the current level in the fraction.
-/// ContFracEval({{a0, b0}, {a1, b1}, ...}) = a0+b0/(a1+b1/(...))
-/// ContFracEval({a0, a1, ...}) = a0+1/(a1+1/(...))
-
-10 # ContFracEval({}, _rest) <-- rest;
-// finish recursion here
-10 # ContFracEval({{_n, _m}}, _rest) <-- n+m+rest;
-15 # ContFracEval({_n}, _rest) <-- n+rest;
-/// Continued fractions with nontrivial numerators
-20 # ContFracEval(list_IsList, _rest)_(IsList(First(list))) <-- First(First(list)) + Rest(First(list)) / ContFracEval(Rest(list), rest);
-/// Continued fractions with unit numerators
-30 # ContFracEval(list_IsList, _rest) <-- First(list) + 1 / ContFracEval(Rest(list), rest);
-
-/// evaluate continued fraction: main interface
-ContFracEval(list_IsList) <-- ContFracEval(list, 0);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ContFracEval",categories="User Functions;Numbers (Operations)"
-*CMD ContFracList --- manipulate continued fractions
-*CMD ContFracEval --- manipulate continued fractions
-*STD
-*CALL
- ContFracList(frac)
- ContFracList(frac, depth)
- ContFracEval(list)
- ContFracEval(list, rest)
-
-*PARMS
-
-{frac} -- a number to be expanded
-
-{depth} -- desired number of terms
-
-{list} -- a list of coefficients
-
-{rest} -- expression to put at the end of the continued fraction
-
-*DESC
-
-The function {ContFracList} computes terms of the continued fraction
-representation of a rational number {frac}. It returns a list of terms of length {depth}. If {depth} is not specified, it returns all terms.
-
-The function {ContFracEval} converts a list of coefficients into a continued fraction expression. The optional parameter {rest} specifies the symbol to put at the end of the expansion. If it is not given, the result is the same as if {rest=0}.
-
-*E.G.
-
- In> A:=ContFracList(33/7 + 0.000001)
- Out> {4,1,2,1,1,20409,2,1,13,2,1,4,1,1,3,3,2};
- In> ContFracEval(Take(A, 5))
- Out> 33/7;
- In> ContFracEval(Take(A,3), remainder)
- Out> 1/(1/(remainder+2)+1)+4;
-
-*SEE ContFrac, GuessRational
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFracList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFracList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFracList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFracList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,64 +0,0 @@
-%mathpiper,def="ContFracList"
-
-/////////////////////////////////////////////////
-/// Continued fractions stuff
-/////////////////////////////////////////////////
-
-/// compute the list of continued fraction coefficients for a given number
-/// if order is not given, computes to the end
-10 # ContFracList(_n) <-- ContFracList(n, Infinity);
-/// compute list of given length
-10 # ContFracList(_n, _depth)_(depth <= 0) <-- {};
-20 # ContFracList(n_IsInteger, _depth) <-- {n};
-// prevent infinite loop when in numeric mode
-30 # ContFracList(n_IsNumber, _depth) _InNumericMode() <-- NonN(ContFracList(Rationalize(n), depth));
-
-40 # ContFracList(n_IsNumber, _depth) <-- ContFracList(Rationalize(n), depth);
-
-/* n/m = Div(n,m) + 1/( m/Mod(n,m) ) */
-35 # ContFracList((n_IsNegativeInteger) / (m_IsInteger), _depth) <-- Push( ContFracList(m/Mod(n,m), depth-1) , Div(n,m)-1);
-
-40 # ContFracList((n_IsInteger) / (m_IsInteger), _depth) <-- Push( ContFracList(m/Mod(n,m), depth-1) , Div(n,m));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ContFracList",categories="User Functions;Numbers (Operations)"
-*CMD ContFracList --- manipulate continued fractions
-*CMD ContFracEval --- manipulate continued fractions
-*STD
-*CALL
- ContFracList(frac)
- ContFracList(frac, depth)
- ContFracEval(list)
- ContFracEval(list, rest)
-
-*PARMS
-
-{frac} -- a number to be expanded
-
-{depth} -- desired number of terms
-
-{list} -- a list of coefficients
-
-{rest} -- expression to put at the end of the continued fraction
-
-*DESC
-
-The function {ContFracList} computes terms of the continued fraction
-representation of a rational number {frac}. It returns a list of terms of length {depth}. If {depth} is not specified, it returns all terms.
-
-The function {ContFracEval} converts a list of coefficients into a continued fraction expression. The optional parameter {rest} specifies the symbol to put at the end of the expansion. If it is not given, the result is the same as if {rest=0}.
-
-*E.G.
-
- In> A:=ContFracList(33/7 + 0.000001)
- Out> {4,1,2,1,1,20409,2,1,13,2,1,4,1,1,3,3,2};
- In> ContFracEval(Take(A, 5))
- Out> 33/7;
- In> ContFracEval(Take(A,3), remainder)
- Out> 1/(1/(remainder+2)+1)+4;
-
-*SEE ContFrac, GuessRational
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFrac.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFrac.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ContFrac.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ContFrac.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,88 +0,0 @@
-%mathpiper,def="ContFrac"
-
-//////////////////////////////////////////////////
-/// continued fractions for polynomials
-//////////////////////////////////////////////////
-
-/// main interface
-10 # ContFrac(_n) <-- ContFrac(n, 6);
-50 # ContFrac(_n,_depth) <-- ContFracEval(ContFracList(n, depth), rest);
-
-40 # ContFrac(n_CanBeUni,_depth)_(Length(VarList(n)) = 1) <--
-[
- ContFracDoPoly(n,depth,VarList(n)[1]);
-];
-
-5 # ContFracDoPoly(_exp,0,_var) <-- rest;
-5 # ContFracDoPoly(0,0,_var) <-- rest;
-10 # ContFracDoPoly(_exp,_depth,_var) <--
-[
- Local(content,exp2,first,second);
- first:=Coef(exp,var,0);
- exp:=exp-first;
- content:=Content(exp);
- exp2:=DivPoly(1,PrimitivePart(exp),var,5+3*depth)-1;
- second:=Coef(exp2,0);
- exp2 := exp2 - second;
- first+content/((1+second)+ContFracDoPoly(exp2,depth-1,var));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ContFrac",categories="User Functions;Numbers (Operations)"
-*CMD ContFrac --- continued fraction expansion
-*STD
-*CALL
- ContFrac(x)
- ContFrac(x, depth)
-
-*PARMS
-
-{x} -- number or polynomial to expand in continued fractions
-
-{depth} -- integer, maximum required depth of result
-
-*DESC
-
-This command returns the continued fraction expansion of {x}, which
-should be either a floating point number or a polynomial. If
-{depth} is not specified, it defaults to 6. The remainder is
-denoted by {rest}.
-
-This is especially useful for polynomials, since series expansions
-that converge slowly will typically converge a lot faster if
-calculated using a continued fraction expansion.
-
-*E.G.
-
- In> PrettyForm(ContFrac(N(Pi)))
-
- 1
- --------------------------- + 3
- 1
- ----------------------- + 7
- 1
- ------------------ + 15
- 1
- -------------- + 1
- 1
- -------- + 292
- rest + 1
-
- Out> True;
- In> PrettyForm(ContFrac(x^2+x+1, 3))
-
- x
- ---------------- + 1
- x
- 1 - ------------
- x
- -------- + 1
- rest + 1
-
- Out> True;
-
-*SEE PAdicExpand, N
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Decimal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Decimal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Decimal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Decimal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,99 +0,0 @@
-%mathpiper,def="Decimal"
-
-10 # Decimal( n_IsInteger ) <-- {n,{0}};
-10 # Decimal( (n_IsPositiveInteger) / (d_IsPositiveInteger) ) <--
-[
- Local(result,rev,first,period,repeat,static);
- result:={Div(n,d)};
- Decimal(result,Mod(n,d),d,350);
- rev:=DecimalFindPeriod(result);
- first:=rev[1];
- period:=rev[2];
- repeat:=result[first .. (first+period-1)];
- static:=result[1 .. (first-1)];
- DestructiveAppend(static,repeat);
-];
-20 # Decimal(_n/_m)_((n/m)<0) <-- "-":Decimal(-n/m);
-
-10 # Decimal(_result , _n , _d,_count ) <--
-[
- While(count>0)
- [
- DestructiveAppend(result,Div(10*n,d));
- n:=Mod(10*n,d);
- count--;
- ];
-];
-
-DecimalFindPeriod(_list) <--
-[
- Local(period,nr,reversed,first,i);
- reversed:=Rest(DestructiveReverse(FlatCopy(Rest(list))));
- nr:=Length(reversed)>>1;
- period:=1;
- first:=reversed[1];
-
- For(i:=1,i1 And list[first] = list[first+period]) first--;
- first++;
-
- {first,period};
-];
-
-DecimalMatches(_reversed,_period) <--
-[
- Local(nr,matches,first);
- nr:=0;
- matches:=True;
- first:=1;
- While((nr<100) And matches)
- [
- matches := (matches And
- (reversed[first .. (first+period-1)] = reversed[(first+period) .. (first+2*period-1)]));
- first:=first+period;
- nr:=nr+period;
- ];
- matches;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Decimal",categories="User Functions;Numbers (Operations)"
-*CMD Decimal --- decimal representation of a rational
-*STD
-*CALL
- Decimal(frac)
-
-*PARMS
-
-{frac} -- a rational number
-
-*DESC
-
-This function returns the infinite decimal representation of a
-rational number {frac}. It returns a list, with the first element
-being the number before the decimal point and the last element the
-sequence of digits that will repeat forever. All the intermediate list
-elements are the initial digits before the period sets in.
-
-*E.G.
-
- In> Decimal(1/22)
- Out> {0,0,{4,5}};
- In> N(1/22,30)
- Out> 0.045454545454545454545454545454;
-
-*SEE N
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/EigenValues.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/EigenValues.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/EigenValues.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/EigenValues.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="EigenValues"
-
-// diagonal matrices will be caught by IsUpperTriangular
-10 # EigenValues(matrix_IsUpperTriangular) <-- Diagonal(matrix);
-10 # EigenValues(matrix_IsLowerTriangular) <-- Diagonal(matrix);
-
-20 # EigenValues(matrix_IsMatrix) <-- Roots(CharacteristicEquation(matrix,xx));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="EigenValues",categories="User Functions;Linear Algebra"
-*CMD EigenValues --- get eigenvalues of a matrix
-*STD
-*CALL
- EigenValues(matrix)
-
-*PARMS
-
-{matrix} -- a square matrix
-
-*DESC
-
-EigenValues returns the eigenvalues of a matrix.
-The eigenvalues x of a matrix M are the numbers such that
-$M*v=x*v$ for some vector.
-
-It first determines the characteristic equation, and then factorizes this
-equation, returning the roots of the characteristic equation
-Det(matrix-x*identity).
-
-*E.G.
-
- In> M:={{1,2},{2,1}}
- Out> {{1,2},{2,1}};
- In> EigenValues(M)
- Out> {3,-1};
-
-*SEE EigenVectors, CharacteristicEquation
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/EigenVectors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/EigenVectors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/EigenVectors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/EigenVectors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,58 +0,0 @@
-%mathpiper,def="EigenVectors"
-
-EigenVectors(_matrix,_eigenvalues) <--
-[
- Local(result,n);
-/* eigenvalues:=N(Eval(eigenvalues)); */
- n:=Length(eigenvalues);
- result:={};
- ForEach(e,eigenvalues)
- [
- Local(possible);
-/* Echo({"1...",result}); */
- possible:=OldSolve(matrix*MakeVector(k,n)==e*MakeVector(k,n),MakeVector(k,n))[1];
-/* Echo({"2..."}); */
-/* Echo({"2..."}); */
-
- If(Not(IsZeroVector(possible)),
- DestructiveAppend(result,possible)
- );
-/* Echo({"3..."}); */
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="EigenVectors",categories="User Functions;Linear Algebra"
-*CMD EigenVectors --- get eigenvectors of a matrix
-*STD
-*CALL
- EigenVectors(A,eigenvalues)
-
-*PARMS
-
-{matrix} -- a square matrix
-
-{eigenvalues} -- list of eigenvalues as returned by {EigenValues}
-
-*DESC
-
-{EigenVectors} returns a list of the eigenvectors of a matrix.
-It uses the eigenvalues and the matrix to set up n equations with
-n unknowns for each eigenvalue, and then calls {Solve} to determine
-the values of each vector.
-
-*E.G.
-
- In> M:={{1,2},{2,1}}
- Out> {{1,2},{2,1}};
- In> e:=EigenValues(M)
- Out> {3,-1};
- In> EigenVectors(M,e)
- Out> {{-ki2/ -1,ki2},{-ki2,ki2}};
-
-*SEE EigenValues, CharacteristicEquation
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/GuessRational.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/GuessRational.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/GuessRational.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/GuessRational.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,92 +0,0 @@
-%mathpiper,def="GuessRational"
-
-/// guess the rational number behind an imprecise number
-/// prec parameter is the max number of digits you can have in the denominator
-GuessRational(_x) <-- GuessRational(x, Floor(1/2*BuiltinPrecisionGet()));
-GuessRational(x_IsRationalOrNumber, prec_IsInteger) <-- [
- Local(denom'estimate, cf, i);
- denom'estimate := 1;
- cf := ContFracList(x);
- For(i:=2, i<=Length(cf) And denom'estimate < 10^prec, i++)
- [ // estimate the denominator
- denom'estimate := denom'estimate * If(
- cf[i] = 1,
- If(
- i+2<=Length(cf), // have at least two more terms, do a full estimate
- RoundTo(N(Eval(cf[i]+1/(cf[i+1]+1/cf[i+2]))), 3),
- // have only one more term
- RoundTo(N(Eval(cf[i]+1/cf[i+1])), 3)
- ),
- // term is not 1, use the simple estimate
- cf[i]
- );
- ];
- If (denom'estimate < 10^prec,
- If(InVerboseMode(), Echo({"GuessRational: all ", i, "terms are within limits"})),
- i-- // do not use the last term
- );
- i--; // loop returns one more number
- If(InVerboseMode(), Echo({"GuessRational: using ", i, "terms of the continued fraction"}));
- ContFracEval(Take(cf, i));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="GuessRational",categories="User Functions;Numbers (Operations)"
-*CMD GuessRational --- find optimal rational approximations
-*STD
-*CALL
- GuessRational(x)
- GuessRational(x, digits)
-
-*PARMS
-
-{x} -- a number to be approximated (must be already evaluated to floating-point)
-
-{digits} -- desired number of decimal digits (integer)
-
-*DESC
-
-The functions {GuessRational(x)} and {NearRational(x)} attempt to find "optimal"
-rational approximations to a given value {x}. The approximations are "optimal"
-in the sense of having smallest numerators and denominators among all rational
-numbers close to {x}. This is done by computing a continued fraction
-representation of {x} and truncating it at a suitably chosen term. Both
-functions return a rational number which is an approximation of {x}.
-
-Unlike the function {Rationalize()} which converts floating-point numbers to
-rationals without loss of precision, the functions {GuessRational()} and
-{NearRational()} are intended to find the best rational that is approximately
-equal to a given value.
-
-The function {GuessRational()} is useful if you have obtained a
-floating-point representation of a rational number and you know
-approximately how many digits its exact representation should contain.
-This function takes an optional second parameter {digits} which limits
-the number of decimal digits in the denominator of the resulting
-rational number. If this parameter is not given, it defaults to half
-the current precision. This function truncates the continuous fraction
-expansion when it encounters an unusually large value (see example).
-This procedure does not always give the "correct" rational number; a
-rule of thumb is that the floating-point number should have at least as
-many digits as the combined number of digits in the numerator and the
-denominator of the correct rational number.
-
-*E.G.
-
-Start with a rational number and obtain a floating-point approximation:
- In> x:=N(956/1013)
- Out> 0.9437314906
- In> Rationalize(x)
- Out> 4718657453/5000000000;
- In> V(GuessRational(x))
-
- GuessRational: using 10 terms of the continued fraction
- Out> 956/1013;
- In> ContFracList(x)
- Out> {0,1,16,1,3,2,1,1,1,1,508848,3,1,2,1,2,2};
-
-*SEE BracketRational, NearRational, ContFrac, ContFracList, Rationalize
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/InverseTaylor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/InverseTaylor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/InverseTaylor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/InverseTaylor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,66 +0,0 @@
-%mathpiper,def="InverseTaylor"
-
-/* InverseTaylor : given a function y=f(x), determine the Taylor series
- * expansion of the inverse f^-1(y)=x this function around y0=f(x0).
- *
- */
-Function("InverseTaylor",{var,val,degree,func})
-[
- Local(l1);
- l1:=UniTaylor(func,var,val,degree);
- val+ReversePoly(l1,var,var,var,degree+1);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="InverseTaylor",categories="User Functions;Series"
-*CMD InverseTaylor --- Taylor expansion of inverse
-*STD
-*CALL
- InverseTaylor(var, at, order) expr
-
-*PARMS
-
-{var} -- variable
-
-{at} -- point to get inverse Taylor series around
-
-{order} -- order of approximation
-
-{expr} -- expression to get inverse Taylor series for
-
-*DESC
-
-This function builds the Taylor series expansion of the inverse of the
-expression "expr" with respect to the variable "var" around "at"
-up to order "order". It uses the function {ReversePoly} to perform the task.
-
-*E.G.
-
- In> PrettyPrinter'Set("PrettyForm")
-
- True
-
- In> exp1 := Taylor(x,0,7) Sin(x)
-
- 3 5 7
- x x x
- x - -- + --- - ----
- 6 120 5040
-
- In> exp2 := InverseTaylor(x,0,7) ArcSin(x)
-
- 5 7 3
- x x x
- --- - ---- - -- + x
- 120 5040 6
-
- In> Simplify(exp1-exp2)
-
- 0
-
-
-*SEE ReversePoly, Taylor, BigOh
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/IsFreeOf.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/IsFreeOf.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/IsFreeOf.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/IsFreeOf.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,59 +0,0 @@
-%mathpiper,def="IsFreeOf"
-
-1 # IsFreeOf({},_expr) <-- True;
-2 # IsFreeOf(var_IsList, _expr) <-- And(IsFreeOf(First(var),expr), IsFreeOf(Rest(var),expr));
-
-4 # IsFreeOf(_var,{}) <-- True;
-5 # IsFreeOf(_var,expr_IsList) <-- And(IsFreeOf(var,First(expr)), IsFreeOf(var,Rest(expr)));
-
-/* Accept any variable. */
-10 # IsFreeOf(_expr,_expr) <-- False;
-
-/* Otherwise check all leafs of a function. */
-11 # IsFreeOf(_var,expr_IsFunction) <-- IsFreeOf(var,Rest(Listify(expr)));
-
-/* Else it doesn't depend on any variable. */
-12 # IsFreeOf(_var,_expr) <-- True;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsFreeOf",categories="User Functions;Predicates"
-*CMD IsFreeOf --- test whether expression depends on variable
-*STD
-*CALL
- IsFreeOf(var, expr)
- IsFreeOf({var, ...}, expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-{var} -- variable to look for in "expr"
-
-*DESC
-
-This function checks whether the expression "expr" (after being
-evaluated) depends on the variable "var". It returns {False} if this is the case and {True}
-otherwise.
-
-The second form test whether the expression depends on any of
-the variables named in the list. The result is {True} if none of the variables appear in the expression and {False} otherwise.
-
-*E.G.
-
- In> IsFreeOf(x, Sin(x));
- Out> False;
- In> IsFreeOf(y, Sin(x));
- Out> True;
- In> IsFreeOf(x, D(x) a*x+b);
- Out> True;
- In> IsFreeOf({x,y}, Sin(x));
- Out> False;
-
-The third command returns {True} because the
-expression {D(x) a*x+b} evaluates to {a}, which does not depend on {x}.
-
-*SEE Contains
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/IsZeroVector.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/IsZeroVector.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/IsZeroVector.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/IsZeroVector.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsZeroVector"
-
-Function("IsZeroVector",{aList}) aList = ZeroVector(Length(aList));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsZeroVector",categories="User Functions;Predicates"
-*CMD IsZeroVector --- test whether list contains only zeroes
-*STD
-*CALL
- IsZeroVector(list)
-
-*PARMS
-
-{list} -- list to compare against the zero vector
-
-*DESC
-
-The only argument given to {IsZeroVector} should be
-a list. The result is {True} if the list contains
-only zeroes and {False} otherwise.
-
-*E.G.
-
- In> IsZeroVector({0, x, 0});
- Out> False;
- In> IsZeroVector({x-x, 1 - D(x) x});
- Out> True;
-
-*SEE IsList, ZeroVector
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/LagrangeInterpolant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/LagrangeInterpolant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/LagrangeInterpolant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/LagrangeInterpolant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,89 +0,0 @@
-%mathpiper,def="LagrangeInterpolant"
-
-LagrangeInt(_var,_list) <--
-[
- Local(nr);
- nr:=Length(list);
- Product(FillList(var,nr)-list);
-];
-
-LagrangeInterpolant(list_IsList,_values,_var) <--
-[
- Local(i,nr,sublist);
- nr:=Length(list);
- result:=0;
- For(i:=1,i<=nr,i++)
- [
- sublist:=FlatCopy(list);
- DestructiveDelete(sublist,i);
- result:=result + values[i]*LagrangeInt(var,sublist)/LagrangeInt(list[i],sublist);
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="LagrangeInterpolant",categories="User Functions;Series"
-*CMD LagrangeInterpolant --- polynomial interpolation
-*STD
-*CALL
- LagrangeInterpolant(xlist, ylist, var)
-
-*PARMS
-
-{xlist} -- list of argument values
-
-{ylist} -- list of function values
-
-{var} -- free variable for resulting polynomial
-
-*DESC
-
-This function returns a polynomial in the variable "var" which
-interpolates the points "(xlist, ylist)". Specifically, the value of
-the resulting polynomial at "xlist[1]" is "ylist[1]", the value at
-"xlist[2]" is "ylist[2]", etc. The degree of the polynomial is not
-greater than the length of "xlist".
-
-The lists "xlist" and "ylist" should be of equal
-length. Furthermore, the entries of "xlist" should be all distinct
-to ensure that there is one and only one solution.
-
-This routine uses the Lagrange interpolant formula to build up the
-polynomial.
-
-*E.G.
-
- In> f := LagrangeInterpolant({0,1,2}, \
- {0,1,1}, x);
- Out> (x*(x-1))/2-x*(x-2);
- In> Eval(Subst(x,0) f);
- Out> 0;
- In> Eval(Subst(x,1) f);
- Out> 1;
- In> Eval(Subst(x,2) f);
- Out> 1;
-
- In> PrettyPrinter'Set("PrettyForm");
-
- True
-
- In> LagrangeInterpolant({x1,x2,x3}, {y1,y2,y3}, x)
-
- y1 * ( x - x2 ) * ( x - x3 )
- ----------------------------
- ( x1 - x2 ) * ( x1 - x3 )
-
- y2 * ( x - x1 ) * ( x - x3 )
- + ----------------------------
- ( x2 - x1 ) * ( x2 - x3 )
-
- y3 * ( x - x1 ) * ( x - x2 )
- + ----------------------------
- ( x3 - x1 ) * ( x3 - x2 )
-
-
-*SEE Subst
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/NearRational.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/NearRational.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/NearRational.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/NearRational.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,104 +0,0 @@
-%mathpiper,def="NearRational"
-
-//////////////////////////////////////////////////
-/// NearRational, GuessRational
-//////////////////////////////////////////////////
-
-/// find rational number with smallest num./denom. near a given number x
-/// See: HAKMEM, MIT AI Memo 239, 02/29/1972, Item 101C
-NearRational(_x) <-- NearRational(x, Floor(1/2*BuiltinPrecisionGet()));
-NearRational(x_IsRationalOrNumber, prec_IsInteger) <-- [
- Local(x1, x2, i, old'prec);
- old'prec := BuiltinPrecisionGet();
- BuiltinPrecisionSet(prec + 8); // 8 guard digits (?)
- x1 := ContFracList(N(Eval(x+10^(-prec))));
- x2 := ContFracList(N(Eval(x-10^(-prec))));
-
- If(InVerboseMode(), Echo("NearRational: x = ", N(Eval(x ))));
- If(InVerboseMode(), Echo("NearRational: xplus = ", N(Eval(x+10^(-prec)))));
- If(InVerboseMode(), Echo("NearRational: xmin = ", N(Eval(x-10^(-prec)))));
-
- If(InVerboseMode(), Echo("NearRational: Length(x1) = ", Length(x1)," ",x1));
- If(InVerboseMode(), Echo("NearRational: Length(x2) = ", Length(x2)," ",x1));
- // find where the continued fractions for "x1" and "x2" differ
- // prepare result in "x1" and length of result in "i"
- For (i:=1, i<=Length(x1) And i<=Length(x2) And x1[i]=x2[i], i++ ) True;
- If(
- i>Length(x1),
- // "x1" ended but matched, so use "x2" as "x1"
- x1:=x2,
- If(
- i>Length(x2),
- // "x2" ended but matched, so use "x1"
- True,
- // neither "x1" nor "x2" ended and there is a mismatch at "i"
- // apply recipe: select the smalest of the differing terms
- x1[i]:=Min(x1[i],x2[i])
- )
- );
- // recipe: x1dd 1 to the lx1st term unless it's the lx1st in the originx1l sequence
- //Ayal added this line, i could become bigger than Length(x1)!
- If(InVerboseMode(), Echo({"NearRational: using ", i, "terms of the continued fraction"}));
- If(i>Length(x1),i:=Length(x1));
- x1[i] := x1[i] + If(i=Length(x1), 0, 1);
- BuiltinPrecisionSet(old'prec);
- ContFracEval(Take(x1, i));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="NearRational",categories="User Functions;Numbers (Operations)"
-*CMD NearRational --- find optimal rational approximations
-*STD
-*CALL
- NearRational(x)
- NearRational(x, digits)
-
-*PARMS
-
-{x} -- a number to be approximated (must be already evaluated to floating-point)
-
-{digits} -- desired number of decimal digits (integer)
-
-*DESC
-
-The functions {GuessRational(x)} and {NearRational(x)} attempt to find "optimal"
-rational approximations to a given value {x}. The approximations are "optimal"
-in the sense of having smallest numerators and denominators among all rational
-numbers close to {x}. This is done by computing a continued fraction
-representation of {x} and truncating it at a suitably chosen term. Both
-functions return a rational number which is an approximation of {x}.
-
-Unlike the function {Rationalize()} which converts floating-point numbers to
-rationals without loss of precision, the functions {GuessRational()} and
-{NearRational()} are intended to find the best rational that is approximately
-equal to a given value.
-
-The function {NearRational(x)} is useful if one needs to
-approximate a given value, i.e. to find an "optimal" rational number
-that lies in a certain small interval around a certain value {x}. This
-function takes an optional second parameter {digits} which has slightly
-different meaning: it specifies the number of digits of precision of
-the approximation; in other words, the difference between {x} and the
-resulting rational number should be at most one digit of that
-precision. The parameter {digits} also defaults to half of the current
-precision.
-
-*E.G.
-
-Start with a rational number and obtain a floating-point approximation:
- In> x:=N(956/1013)
- Out> 0.9437314906
- In> Rationalize(x)
- Out> 4718657453/5000000000;
-The first 10 terms of this continued fraction correspond to the correct continued fraction for the original rational number.
- In> NearRational(x)
- Out> 218/231;
-This function found a different rational number closeby because the precision was not high enough.
- In> NearRational(x, 10)
- Out> 956/1013;
-
-*SEE BracketRational, GuessRational, ContFrac, ContFracList, Rationalize
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/NewLine.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/NewLine.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/NewLine.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/NewLine.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="NewLine"
-
-NewLine() := WriteN(Nl(),1);
-NewLine(n):= WriteN(Nl(),n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="NewLine",categories="User Functions;Input/Output"
-*CMD NewLine --- print one or more newline characters
-*STD
-*CALL
- NewLine()
- NewLine(nr)
-
-*PARMS
-
-{nr} -- the number of newline characters to print
-
-*DESC
-
-The command {NewLine()} prints one newline character
-on the current output. The second form prints "nr" newlines on the
-current output. The result is always True.
-
-*E.G. notest
-
- In> NewLine();
-
- Out> True;
-
-*SEE Echo, Write, Space
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Nl.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Nl.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Nl.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Nl.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="Nl"
-
-Nl():=
-"
-";
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Nl",categories="User Functions;Input/Output"
-*CMD Nl --- the newline character
-*STD
-*CALL
- Nl()
-
-*DESC
-
-This function returns a string with one element in it, namely a newline
-character. This may be useful for building strings to send to some
-output in the end.
-
-Note that the second letter in the name of this command is a lower
-case {L} (from "line").
-
-*E.G. notest
-
- In> WriteString("First line" : Nl() : "Second line" : Nl());
- First line
- Second line
- Out> True;
-
-*SEE NewLine
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Rationalize.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Rationalize.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Rationalize.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Rationalize.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="Rationalize"
-
-Function("Rationalize",{a'number})
- Substitute(a'number,{{x},IsNumber(x) And Not(IsInteger(x))},"RationalizeNumber");
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Rationalize",categories="User Functions;Numbers (Operations)"
-*CMD Rationalize --- convert floating point numbers to fractions
-*STD
-*CALL
- Rationalize(expr)
-
-*PARMS
-
-{expr} -- an expression containing real numbers
-
-*DESC
-
-This command converts every real number in the expression "expr"
-into a rational number. This is useful when a calculation needs to be
-done on floating point numbers and the algorithm is unstable.
-Converting the floating point numbers to rational numbers will force
-calculations to be done with infinite precision (by using rational
-numbers as representations).
-
-It does this by finding the smallest integer $n$ such that multiplying
-the number with $10^n$ is an integer. Then it divides by $10^n$ again,
-depending on the internal gcd calculation to reduce the resulting
-division of integers.
-
-*E.G.
-
- In> {1.2,3.123,4.5}
- Out> {1.2,3.123,4.5};
- In> Rationalize(%)
- Out> {6/5,3123/1000,9/2};
-
-*SEE IsRational
-
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/RationalizeNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/RationalizeNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/RationalizeNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/RationalizeNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="RationalizeNumber"
-
-Function("RationalizeNumber",{x})
-[
- Check(IsNumber(x),"RationalizeNumber: Error: " : (ToString()Write(x)) :" is not a number");
- Local(n,i);
- n:=1;
- i:=0;
- // We can not take for granted that the internal representation is rounded properly...
- While(i<=BuiltinPrecisionGet() And Not(FloatIsInt(x)))
- [
- n:=n*10; x:=x*10;
- i:=i+1;
-//Echo(x,"/",n);
- ];
- Floor(x+0.5)/n; //FIXME forced thunking to string representation
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ReversePoly.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ReversePoly.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/ReversePoly.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/ReversePoly.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,100 +0,0 @@
-%mathpiper,def="ReversePoly"
-
-/* Lagrangian power series reversion. Copied
- from Knuth seminumerical algorithms */
-
-ReversePoly(_f,_g,_var,_newvar,_degree) <--
-[
- Local(orig,origg,G,V,W,U,n,initval,firstder,j,k,newsum);
- orig:=MakeUni(f,var);
- origg:=MakeUni(g,var);
- initval:=Coef(orig,0);
- firstder:=Coef(orig,1);
- V:=Coef(orig,1 .. Degree(orig));
- V:=Concat(V,FillList(0,degree));
- G:=Coef(origg,1 .. Degree(origg));
- G:=Concat(G,FillList(0,degree));
- W:=FillList(0,Length(V)+2);
- W[1]:=G[1]/firstder;
- U:=FillList(0,Length(V)+2);
- U[1]:=1/firstder;
- n:=1;
- While(n f(x):=Eval(Expand((1+x)^4))
- Out> True;
- In> g(x) := x^2
- Out> True;
- In> h(y):=Eval(ReversePoly(f(x),g(x),x,y,8))
- Out> True;
- In> BigOh(h(f(x)),x,8)
- Out> x^2;
- In> h(x)
- Out> (-2695*(x-1)^7)/131072+(791*(x-1)^6)
- /32768 +(-119*(x-1)^5)/4096+(37*(x-1)^4)
- /1024+(-3*(x-1)^3)/64+(x-1)^2/16;
-
-*SEE InverseTaylor, Taylor, BigOh
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Series.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Series.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Series.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Series.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def=""
-
-//todo:tk:not implemented.
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Space.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Space.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/Space.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/Space.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="Space"
-
-Space() := WriteN(" ",1);
-Space(n):= WriteN(" ",n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Space",categories="User Functions;Input/Output"
-*CMD Space --- print one or more spaces
-*STD
-*CALL
- Space()
- Space(nr)
-
-*PARMS
-
-{nr} -- the number of spaces to print
-
-*DESC
-
-The command {Space()} prints one space on the
-current output. The second form prints {nr} spaces on the current
-output. The result is always True.
-
-*E.G. notest
-
- In> Space(5);
- Out> True;
-
-*SEE Echo, Write, NewLine
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/TRun.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/TRun.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/TRun.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/TRun.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def=""
-
-//todo:tk:this function is completely commented out.
-
-/*
-TRun(_f,_g,_degree)<--
-[
- Local(l2,l3,l4);
- l2:=ReversePoly(f,g,t,z,degree);
- l3:=Subst(z,f)l2;
- l4:=BigOh(l3,t,degree);
- Echo({g," == ",l4});
- NewLine();
-];
-
-TRun(t+t^2,t,10);
-TRun(t/2-t^2,t,10);
-TRun(t/2-t^2,3+t+t^2/2,10);
-TRun(2+t/2-t^2,t,10);
-*/
-
-/*
-TRun(_f,_degree)<--
-[
- Local(l2,l3,l4);
- l2:=InverseTaylor(t,0,degree)f;
- l3:=Subst(t,Taylor(t,0,degree)f)l2;
- l4:=BigOh(l3,t,degree);
-
- Echo({t," == ",Simplify(l4)});
- NewLine();
-];
-TRun(Sin(a*t),3);
-TRun(a^t,3);
-TRun(a^t,3);
-TRun(t+t^2,10);
-TRun(t/2-t^2,10);
-TRun(t/2-t^2,10);
-TRun(2+t/2-t^2,10);
-*/
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/UniqueConstant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/UniqueConstant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/UniqueConstant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/UniqueConstant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-%mathpiper,def="UniqueConstant"
-
-UniqueConstant() <--
-[
- Local(result);
- result := String(LocalSymbols(C)(C));
- Atom(StringMidGet(2,Length(result)-1,result));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="UniqueConstant",categories="User Functions;Variables"
-*CMD UniqueConstant --- create a unique identifier
-*STD
-*CALL
- UniqueConstant()
-
-*DESC
-
-This function returns a unique constant atom each time you call
-it. The atom starts with a C character, and a unique number is
-appended to it.
-
-*E.G.
-
- In> UniqueConstant()
- Out> C9
- In> UniqueConstant()
- Out> C10
-
-*SEE LocalSymbols
-
-*CMD LocalSymbols --- create unique local symbols with given prefix
-*STD
-*CALL
- LocalSymbols(var1, var2, ...) body
-
-*PARMS
-
-{var1}, {var2}, ... -- atoms, symbols to be made local
-
-{body} -- expression to execute
-
-*DESC
-
-Given the symbols passed as the first arguments to LocalSymbols a set of local
-symbols will be created, and creates unique ones for them, typically of the
-form {$}, where {symbol} was the symbol entered by the user,
-and {number} is a unique number. This scheme was used to ensure that a generated
-symbol can not accidentally be entered by a user.
-
-This is useful in cases where a guaranteed free variable is needed,
-for example, in the macro-like functions ({For}, {While}, etc.).
-
-*E.G. notest
-
- In> LocalSymbols(a,b)a+b
- Out> $a6+ $b6;
-
-*SEE UniqueConstant
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/WithValue.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/WithValue.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/WithValue.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/WithValue.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="WithValue"
-
-TemplateFunction("WithValue",{var,val,expr})
-[
- If(IsList(var),
- ApplyPure("MacroLocal",var),
- MacroLocal(var)
- );
- ApplyPure(":=",{var,val});
- Eval(expr);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="WithValue",categories="User Functions;Control Flow"
-*CMD WithValue --- temporary assignment during an evaluation
-*STD
-*CALL
- WithValue(var, val, expr)
- WithValue({var,...}, {val,...}, expr)
-
-*PARMS
-
-{var} -- variable to assign to
-
-{val} -- value to be assigned to "var"
-
-{expr} -- expression to evaluate with "var" equal to "val"
-
-*DESC
-
-First, the expression "val" is assigned to the variable
-"var". Then, the expression "expr" is evaluated and
-returned. Finally, the assignment is reversed so that the variable
-"var" has the same value as it had before {WithValue} was evaluated.
-
-The second calling sequence assigns the first element in the list of
-values to the first element in the list of variables, the second value
-to the second variable, etc.
-
-*E.G.
-
- In> WithValue(x, 3, x^2+y^2+1);
- Out> y^2+10;
- In> WithValue({x,y}, {3,2}, x^2+y^2+1);
- Out> 14;
-
-*SEE Subst, /:
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/WriteN.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/WriteN.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/newly/WriteN.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/newly/WriteN.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def="WriteN"
-
-WriteN(string,n) :=
-[
- Local(i);
- For(i:=1,i<=n,i++) WriteString(string);
- True;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/BellNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/BellNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/BellNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/BellNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="BellNumber"
-
-10 # BellNumber(n_IsInteger) <-- Sum(k,1,n,StirlingNumber2(n,k));
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/CatalanNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/CatalanNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/CatalanNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/CatalanNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="CatalanNumber"
-
-CatalanNumber(_n) <--
-[
- Check( IsPositiveInteger(n), "CatalanNumber: Error: argument must be positive" );
- BinomialCoefficient(2*n,n)/(n+1);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="CatalanNumber",categories="User Functions;Number Theory"
-*CMD CatalanNumber --- return the {n}th Catalan Number
-*STD
-*CALL
- CatalanNumber(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function returns the {n}-th Catalan number, defined as $BinomialCoefficient(2*n,n)/(n+1)$.
-
-*E.G.
-
- In> CatalanNumber(10)
- Out> 16796;
- In> CatalanNumber(5)
- Out> 42;
-
-*SEE BinomialCoefficient
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/CheckIntPower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/CheckIntPower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/CheckIntPower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/CheckIntPower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="CheckIntPower",scope="private"
-
-/// Check whether n is a power of some integer, assuming that it has no prime factors <= limit.
-/// This routine uses only integer arithmetic.
-/// Returns {p, s} where s is the smallest prime integer such that n=p^s. (p is not necessarily a prime!)
-/// If no powers found, returns {n, 1}. Primality testing of n is not done.
-CheckIntPower(n, limit) :=
-[
- Local(s0, s, root);
- If(limit<=1, limit:=2); // guard against too low value of limit
- // compute the bound on power s
- s0 := IntLog(n, limit);
- // loop: check whether n^(1/s) is integer for all prime s up to s0
- root := 0;
- s := 0;
- While(root = 0 And NextPseudoPrime(s)<=s0) // root=0 while no root is found
- [
- s := NextPseudoPrime(s);
- root := IntNthRoot(n, s);
- If(
- root^s = n, // found root
- True,
- root := 0
- );
- ];
- // return result
- If(
- root=0,
- {n, 1},
- {root, s}
- );
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/DigitalRoot.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/DigitalRoot.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/DigitalRoot.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/DigitalRoot.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-%mathpiper,def="DigitalRoot"
-
-// Digital root of n (repeatedly add digits until reach a single digit).
-10 # DigitalRoot(n_IsPositiveInteger) <-- If(n%9=0,9,n%9);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Divisors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Divisors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Divisors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Divisors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-%mathpiper,def="Divisors"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Theorem 6.2 p112
-5 # Divisors(0) <-- 0;
-5 # Divisors(1) <-- 1;
-// Unsure about if there should also be a function that returns
-// n's divisors, may have to change name in future
-10 # Divisors(_n) <--
-[
- Check(IsPositiveInteger(n),
- "Divisors: argument must be positive integer");
- Local(len,sum,factors,i);
- sum:=1;
- factors:=Factors(n);
- len:=Length(factors);
- For(i:=1,i<=len,i++)[
- sum:=sum*(factors[i][2]+1);
- ];
- sum;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Divisors",categories="User Functions;Number Theory"
-*CMD Divisors --- number of divisors
-*STD
-*CALL
- Divisors(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-{Divisors} returns the number of positive divisors of a number.
-A number is prime if and only if it has two divisors, 1 and itself.
-
-*E.G.
- In> Divisors(180)
- Out> 18;
- In> Divisors(37)
- Out> 2;
-
-*SEE DivisorsSum, ProperDivisors, ProperDivisorsSum, Moebius
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/DivisorsSum.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/DivisorsSum.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/DivisorsSum.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/DivisorsSum.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,52 +0,0 @@
-%mathpiper,def="DivisorsSum"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Theorem 6.2 p112
-5 # DivisorsSum(0) <-- 0;
-5 # DivisorsSum(1) <-- 1;
-10 # DivisorsSum(_n) <--
-[
- Check(IsPositiveInteger(n),
- "DivisorsSum: argument must be positive integer");
- Local(factors,i,sum,len,p,k);
- p:=0;k:=0;
- factors:={};
- factors:=Factors(n);
- len:=Length(factors);
- sum:=1;
- For(i:=1,i<=len,i++)[
- p:=factors[i][1];
- k:=factors[i][2];
- sum:=sum*(p^(k+1)-1)/(p-1);
- ];
- sum;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="DivisorsSum",categories="User Functions;Number Theory"
-*CMD DivisorsSum --- the sum of divisors
-*STD
-*CALL
- DivisorsSum(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-{DivisorsSum} returns the sum all numbers that divide it. A number
-{n} is prime if and only if the sum of its divisors are {n+1}.
-
-*E.G.
-
- In> DivisorsSum(180)
- Out> 546;
- In> DivisorsSum(37)
- Out> 38;
-
-*SEE DivisorsSum, ProperDivisors, ProperDivisorsSum, Moebius
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/EulerArray.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/EulerArray.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/EulerArray.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/EulerArray.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-%mathpiper,def="EulerArray"
-
-/** Compute an array of Euler numbers using recurrence relations.
-*/
-10 # EulerArray(n_IsInteger) <--
-[
- Local(E,i,sum,r);
- E:=ZeroVector(n+1);
- E[1]:=1;
- For(i:=1,2*i<=n,i++)[
- sum:=0;
- For(r:=0,r<=i-1,r++)[
- sum:=sum+BinomialCoefficient(2*i,2*r)*E[2*r+1];
- ];
- E[2*i+1] := -sum;
- ];
- E;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Eulerian.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Eulerian.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Eulerian.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Eulerian.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="Eulerian"
-
-Eulerian(n_IsInteger,k_IsInteger) <-- Sum(j,0,k+1,(-1)^j*BinomialCoefficient(n+1,j)*(k-j+1)^n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Eulerian",categories="User Functions;Combinatorics"
-*CMD Eulerian --- Eulerian numbers
-*STD
-*CALL
- Eulerian(n,m)
-
-*PARMS
-
-{n}, {m} --- integers
-
-*DESC
-
-The Eulerian numbers can be viewed as a generalization of the binomial coefficients,
-and are given explicitly by $$ Sum(j,0,k+1,(-1)^j*BinomialCoefficient(n+1,j)*(k-j+1)^n) $$ .
-
-*E.G.
-
- In> Eulerian(6,2)
- Out> 302;
- In> Eulerian(10,9)
- Out> 1;
-
-*SEE BinomialCoefficient
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Euler.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Euler.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Euler.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Euler.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="Euler"
-
-5 # Euler(0) <-- 1;
-10 # Euler(n_IsOdd) <-- 0;
-10 # Euler(n_IsEven) <-- - Sum(r,0,n/2-1,BinomialCoefficient(n,2*r)*Euler(2*r));
-10 # Euler(n_IsNonNegativeInteger,_x) <-- Sum(i,0,Round(n/2),BinomialCoefficient(n,2*i)*Euler(2*i)*(x-1/2)^(n-2*i)/2^(2*i));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Euler",categories="User Functions;Special"
-*CMD Euler --- Euler numbers and polynomials
-*STD
-*CALL
- Euler(index)
- Euler(index,x)
-
-*PARMS
-
-{x} -- expression that will be the variable in the polynomial
-
-{index} -- expression that can be evaluated to an integer
-
-*DESC
-
-{Euler(n)} evaluates the $n$-th Euler number. {Euler(n,x)} returns the $n$-th Euler polynomial in the variable $x$.
-
-*E.G.
-
- In> Euler(6)
- Out> -61;
- In> A:=Euler(5,x)
- Out> (x-1/2)^5+(-10*(x-1/2)^3)/4+(25*(x-1/2))/16;
- In> Simplify(A)
- Out> (2*x^5-5*x^4+5*x^2-1)/2;
-
-*SEE BinomialCoefficient
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/FermatNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/FermatNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/FermatNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/FermatNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="FermatNumber"
-
-Function("FermatNumber",{n})[
- Check(IsPositiveInteger(n),
- "FermatNumber: argument must be a positive integer");
- 2^(2^n)+1;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="FermatNumber",categories="User Functions;Number Theory"
-*CMD FermatNumber --- return the {n}th Fermat Number
-*STD
-*CALL
- FermatNumber(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function returns the {n}-th Fermat number, which is defined as
-$2^(2^n) + 1$.
-
-*E.G.
-
- In> FermatNumber(7)
- Out> 340282366920938463463374607431768211457;
-
-*SEE Factor
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/AddGaussianFactor.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/AddGaussianFactor.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/AddGaussianFactor.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/AddGaussianFactor.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-%mathpiper,def="AddGaussianFactor"
-
-/* AddGaussianFactor: auxiliary function for Gaussian Factors.
-L is a lists of factors of the Gaussian integer z and p is a Gaussian prime
-that we want to add to the list. We first find the exponent e of p in the
-decomposition of z (into Gaussian primes). If it is not zero, we add {p,e}
-to the list */
-
-AddGaussianFactor(L_IsList,z_IsGaussianInteger,p_IsGaussianInteger) <--
-[
- Local(e);
- e :=0;
- While (IsGaussianInteger(z:= z/p)) e++;
- If (e != 0, DestructiveAppend(L,{p,e}));
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/FactorGaussianInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/FactorGaussianInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/FactorGaussianInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/FactorGaussianInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="FactorGaussianInteger"
-
-// Algorithm adapted from: Number Theory: A Programmer's Guide
-// Mark Herkommer
-// Program 8.7.1c, p 264
-// This function needs to be modified to return the factors in
-// data structure instead of printing them out
-
-// THIS FUNCTION IS DEPRECATED NOW!
-// Use GaussianFactors instead (Pablo)
-// I've leave this here so that you can compare the eficiency of one
-// function against the other
-
-Function("FactorGaussianInteger",{x}) [
- Check( IsGaussianInteger(x), "FactorGaussianInteger: argument must be a Gaussian integer");
- Local(re,im,norm,a,b,d,i,j);
-
- re:=Re(x);im:=Im(x);
-
- If(re<0, re:=(-re) );
- If(im<0, im:=(-im) );
- norm:=re^2+im^2;
-
- if( IsComposite(norm) )[
- For(i:=0, i^2 <= norm, i++ )[ // real part
- For(j:=0, i^2 + j^2 <= norm, j++)[ // complex part
- if( Not( (i = re And j = im) Or
- (i = im And j = re) ) )[ // no associates
- d:=i^2+j^2;
- if( d > 1 )[
- a := re * i + im * j;
- b := im * i - re * j;
- While( (Mod(a,d) = 0) And (Mod(b,d) = 0) ) [
- FactorGaussianInteger(Complex(i,j));
- re:= a/d;
- im:= b/d;
- a := re * i + im * j;
- b := im * i - re * j;
- norm := re^2 + im^2;
- ];
- ];
- ];
- ];
- ];
- If( re != 1 Or im != 0, Echo(Complex(re,im)) );
- ] else [
- Echo(Complex(re,im));
- ];
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactorPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactorPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactorPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactorPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-%mathpiper,def="GaussianFactorPrime"
-
-/* GaussianFactorPrime(p): auxiliary function for Gaussian factors.
-If p is a rational prime of the form 4n+1, we find a factor of p in the
-Gaussian Integers. We compute
- a = (2n)!
-By Wilson's theorem a^2 is -1 (mod p), it follows that
-
- p| (a+I)(a-I)
-
-in the Gaussian integers. The desired factor is then the Gaussian GCD of a+i
-and p. Note: If the result is Complex(a,b), then p=a^2+b^2 */
-
-GaussianFactorPrime(p_IsInteger) <-- [
- Local(a,i);
- a := 1;
- For (i:=2,i<=(p-1)/2,i++) a := Mod(a*i,p);
- GaussianGcd(a+I,p);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianFactors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,97 +0,0 @@
-%mathpiper,def="GaussianFactors"
-
-Retract("GaussianFactors",*);
-
-/*
-GaussianFactors(n) : returns a list of factors of n, in a similar way to Factors(n).
-If n is a rational integer, we factor n in the Gaussian integers, by first
-factoring it in the rational integers, and after that factoring each of
-its integer prime factors.
-*/
-
-10 # GaussianFactors(n_IsInteger) <--
-[
- // Chosing to factor this integer as a Gaussian Integer
- Local(ifactors,gfactors,p,alpha);
- ifactors := FactorizeInt(n); // since we know it is an integer
- gfactors := {};
- ForEach(p,ifactors)
- [
- If (p[1]=2, [ DestructiveAppend(gfactors,{1+I,p[2]});
- DestructiveAppend(gfactors,{1-I,p[2]}); ]);
- If (Mod(p[1],4)=3, DestructiveAppend(gfactors,p));
- If (Mod(p[1],4)=1, [ alpha := GaussianFactorPrime(p[1]);
- DestructiveAppend(gfactors,{alpha,p[2]});
- DestructiveAppend(gfactors,{Conjugate(alpha),p[2]});
- ]);
- ];
-gfactors;
-];
-
-/*
-If z is is a Gaussian integer, we find its possible Gassian prime factors,
-by factoring its norm
-*/
-
-20 # GaussianFactors(z_IsGaussianInteger) <--
-[
- Local(n,nfactors,gfactors,p);
- gfactors :={};
- n := GaussianNorm(z);
- nfactors := Factors(n);
- ForEach(p,nfactors)
- [
- If (p[1]=2, [ AddGaussianFactor(gfactors,z,1+I);]);
- If (Mod(p[1],4)=3, AddGaussianFactor(gfactors,z,p[1]));
- If (Mod(p[1],4)=1, [ Local(alpha);
- alpha := GaussianFactorPrime(p[1]);
- AddGaussianFactor(gfactors,z,alpha);
- AddGaussianFactor(gfactors,z,Conjugate(alpha));
- ]);
- ];
- gfactors;
-];
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-%mathpiper_docs,name="GaussianFactors",categories="User Functions;Number Theory"
-*CMD GaussianFactors --- factorization in Gaussian integers
-*STD
-*CALL
- GaussianFactors(z)
-
-*PARMS
-
-{z} -- Gaussian integer
-
-*DESC
-
-This function decomposes a Gaussian integer number {z} into a product of
-Gaussian prime factors.
-A Gaussian integer is a complex number with integer real and imaginary parts.
-A Gaussian integer $z$ can be decomposed into Gaussian primes essentially in a
-unique way (up to Gaussian units and associated prime factors), i.e. one
-can write $z$ as
-$$z = u*p[1]^n[1] * ... * p[s]^n[s]$$,
-where $u$ is a Gaussian unit and $p[1]$, $p[2]$, ..., $p[s]$ are Gaussian primes.
-
-The factorization is returned as a list of pairs. The first member of
-each pair is the factor (a Gaussian integer) and the second member denotes the power to
-which this factor should be raised. So the factorization is returned as
-a list, e.g. {{{p1,n1}, {p2,n2}, ...}}.
-
-*E.G.
-
- In> GaussianFactors(5)
- Out> {{Complex(2,1),1},{Complex(2,-1),1}};
- In> GaussianFactors(3+I)
- Out> {{Complex(1,1),1},{Complex(2,-1),1}};
-
-*SEE Factors, IsGaussianPrime, IsGaussianUnit
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianGcd.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianGcd.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianGcd.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianGcd.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="GaussianGcd"
-
-10 # GaussianGcd(n_IsGaussianInteger,m_IsGaussianInteger) <--
-[
- If(N(Abs(m))=0,n, GaussianGcd(m,n - m*Round(n/m) ) );
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="GaussianGcd",categories="User Functions;Number Theory"
-*CMD GaussianGcd --- greatest common divisor in Gaussian integers
-*STD
-*CALL
- GaussianGcd(z,w)
-
-*PARMS
-
-{z}, {w} -- Gaussian integers
-
-*DESC
-
-This function returns the greatest common divisor, in the ring of Gaussian
-integers, computed using Euclid's algorithm. Note that in the Gaussian
-integers, the greatest common divisor is only defined up to a Gaussian unit factor.
-
-*E.G.
-
- In> GaussianGcd(2+I,5)
- Out> Complex(2,1);
-The GCD of two mutually prime Gaussian integers might come out to be equal to some Gaussian unit instead of $1$:
- In> GaussianGcd(2+I,3+I)
- Out> -1;
-
-*SEE Gcd, Lcm, IsGaussianUnit
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianMod.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianMod.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianMod.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianMod.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="GaussianMod"
-
-GaussianMod(z_IsGaussianInteger,w_IsGaussianInteger) <-- z - w * Round(z/w);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianNorm.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianNorm.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianNorm.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/GaussianNorm.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,30 +0,0 @@
-%mathpiper,def="GaussianNorm"
-
-GaussianNorm(z_IsGaussianInteger) <-- Re(z)^2+Im(z)^2;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="GaussianNorm",categories="User Functions;Number Theory"
-*CMD GaussianNorm --- norm of a Gaussian integer
-*STD
-*CALL
- GaussianNorm(z)
-
-*PARMS
-
-{z} -- Gaussian integer
-
-*DESC
-
-This function returns the norm of a Gaussian integer $z=a+b*I$, defined as
-$a^2+b^2$.
-
-*E.G.
-
- In> GaussianNorm(2+I)
- Out> 5;
-
-*SEE IsGaussianInteger
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,41 +0,0 @@
-%mathpiper,def="IsGaussianInteger"
-
-5 # IsGaussianInteger(x_IsList) <-- False;
-
-// ?????? why is the following rule needed?
-// 5 # IsGaussianInteger(ProductPrimesTo257) <-- False;
-
-10 # IsGaussianInteger(x_IsComplex) <-- (IsInteger(Re(x)) And IsInteger(Im(x)));
-// to catch IsGaussianInteger(x+2) from Apart
-15 # IsGaussianInteger(_x) <-- False;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsGaussianInteger",categories="User Functions;Predicates"
-*CMD IsGaussianInteger --- test for a Gaussian integer
-*STD
-*CALL
- IsGaussianInteger(z)
-*PARMS
-
-{z} -- a complex or real number
-
-*DESC
-
-This function returns {True} if the argument is a Gaussian integer and {False} otherwise.
-A Gaussian integer is a generalization
-of integers into the complex plane. A complex number $a+b*I$ is a Gaussian
-integer if and only if $a$ and $b$ are integers.
-
-*E.G.
- In> IsGaussianInteger(5)
- Out> True;
- In> IsGaussianInteger(5+6*I)
- Out> True;
- In> IsGaussianInteger(1+2.5*I)
- Out> False;
-
-*SEE IsGaussianUnit, IsGaussianPrime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,69 +0,0 @@
-%mathpiper,def="IsGaussianPrime"
-
-Function("IsGaussianPrime",{x})
-[
- if( IsGaussianInteger(x) )[
- if( IsZero(Re(x)) )[
- ( Abs(Im(x)) % 4 = 3 And IsPrime(Abs(Im(x))) );
- ] else if ( IsZero(Im(x)) ) [
- ( Abs(Re(x)) % 4 = 3 And IsPrime(Abs(Re(x))) );
- ] else [
- IsPrime(Re(x)^2 + Im(x)^2);
- ];
- ] else [
- False;
- ];
-
-];
-
-
-/*
-10 # IsGaussianPrime(p_IsInteger) <-- IsPrime(p) And Mod(p,3)=1;
-20 # IsGaussianPrime(p_IsGaussianInteger) <-- IsPrime(GaussianNorm(p));
-*/
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsGaussianPrime",categories="User Functions;Number Theory;Predicates"
-*CMD IsGaussianPrime --- test for a Gaussian prime
-*STD
-*CALL
- IsGaussianPrime(z)
-*PARMS
-
-{z} -- a complex or real number
-
-*DESC
-
-This function returns {True} if the argument
-is a Gaussian prime and {False} otherwise.
-
-A prime element $x$ of a ring is divisible only by the units of
-the ring and by associates of $x$.
-("Associates" of $x$ are elements of the form $x*u$ where $u$ is
-a unit of the ring).
-
-Gaussian primes are Gaussian integers $z=a+b*I$ that satisfy one of the
-following properties:
-
-* If $Re(z)$ and $Im(z)$ are nonzero then $z$ is a Gaussian prime if and only
-if $Re(z)^2 + Im(z)^2$ is an ordinary prime.
-* If $Re(z)==0$ then $z$ is a Gaussian prime if and only if $Im(z)$ is an
-ordinary prime and $Im(z):=Mod(3,4)$.
-* If $Im(z)==0$ then $z$ is a Gaussian prime
-if and only if $Re(z)$ is an ordinary prime and $Re(z):=Mod(3,4)$.
-
-*E.G.
- In> IsGaussianPrime(13)
- Out> False;
- In> IsGaussianPrime(2+2*I)
- Out> False;
- In> IsGaussianPrime(2+3*I)
- Out> True;
- In> IsGaussianPrime(3)
- Out> True;
-
-*SEE IsGaussianInteger, GaussianFactors
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianUnit.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianUnit.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianUnit.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/gaussianintegers/IsGaussianUnit.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,34 +0,0 @@
-%mathpiper,def="IsGaussianUnit"
-
-IsGaussianUnit(z_IsGaussianInteger) <-- GaussianNorm(z)=1;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsGaussianUnit",categories="User Functions;Number Theory;Predicates"
-*CMD IsGaussianUnit --- test for a Gaussian unit
-*STD
-*CALL
- IsGaussianUnit(z)
-*PARMS
-
-{z} -- a Gaussian integer
-
-*DESC
-
-This function returns {True} if the argument is a unit in the Gaussian
-integers and {False} otherwise. A unit in a ring is an element that divides
-any other element.
-
-There are four "units" in the ring of Gaussian integers, which are
-$1$, $-1$, $I$, and $-I$.
-
-*E.G.
- In> IsGaussianInteger(I)
- Out> True;
- In> IsGaussianUnit(5+6*I)
- Out> False;
-
-*SEE IsGaussianInteger, IsGaussianPrime, GaussianNorm
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/GetPrimePower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/GetPrimePower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/GetPrimePower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/GetPrimePower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="GetPrimePower"
-
-/// Check whether n is a power of some prime integer and return that integer and the power.
-/// This routine uses only integer arithmetic.
-/// Returns {p, s} where p is a prime and n=p^s.
-/// If no powers found, returns {n, 1}. Primality testing of n is not done.
-20 # GetPrimePower(n_IsPositiveInteger) <--
-[
- Local(s, factors, new'factors);
- // first, separate any small prime factors
- factors := TrialFactorize(n, 257); // "factors" = {n1, {p1,s1},{p2,s2},...} or just {n} if no factors found
- If(
- Length(factors) > 1, // factorized into something
- // now we return {n, 1} either if we haven't completely factorized, or if we factorized into more than one prime factor; otherwise we return the information about prime factors
- If(
- factors[1] = 1 And Length(factors) = 2, // factors = {1, {p, s}}, so we have a prime power n=p^s
- factors[2],
- {n, 1}
- ),
- // not factorizable into small prime factors -- use main algorithm
- [
- factors := CheckIntPower(n, 257); // now factors = {p, s} with n=p^s
- If(
- factors[2] > 1, // factorized into something
- // now need to check whether p is a prime or a prime power and recalculate "s"
- If(
- IsPrime(factors[1]),
- factors, // ok, prime power, return information
- [ // not prime, need to check if it's a prime power
- new'factors := GetPrimePower(factors[1]); // recursive call; now new'factors = {p1, s1} where n = (p1^s1)^s; we need to check that s1>1
- If(
- new'factors[2] > 1,
- {new'factors[1], new'factors[2]*factors[2]}, // recalculate and return prime power information
- {n, 1} // not a prime power
- );
- ]
- ),
- // not factorizable -- return {n, 1}
- {n, 1}
- );
- ]
- );
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/HarmonicNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/HarmonicNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/HarmonicNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/HarmonicNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,48 +0,0 @@
-%mathpiper,def="HarmonicNumber"
-
-10 # HarmonicNumber(n_IsInteger) <-- HarmonicNumber(n,1);
-HarmonicNumber(n_IsInteger,r_IsPositiveInteger) <--
-[
- // small speed up
- if( r=1 )[
- Sum(k,1,n,1/k);
- ] else [
- Sum(k,1,n,1/k^r);
- ];
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HarmonicNumber",categories="User Functions;Number Theory"
-*CMD HarmonicNumber --- return the {n}th Harmonic Number
-*STD
-*CALL
- HarmonicNumber(n)
- HarmonicNumber(n,r)
-*PARMS
-
-{n}, {r} -- positive integers
-
-*DESC
-
-This function returns the {n}-th Harmonic number, which is defined
-as $Sum(k,1,n,1/k)$. If given a second argument, the Harmonic number
-of order $r$ is returned, which is defined as $Sum(k,1,n,k^(-r))$.
-
-*E.G.
-
- In> HarmonicNumber(10)
- Out> 7381/2520;
- In> HarmonicNumber(15)
- Out> 1195757/360360;
- In> HarmonicNumber(1)
- Out> 1;
- In> HarmonicNumber(4,3)
- Out> 2035/1728;
-
-
-
-*SEE Sum
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IntLog.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IntLog.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IntLog.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IntLog.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,74 +0,0 @@
-%mathpiper,def="IntLog"
-
-/// Return integer part of the logarithm of x in given base. Use only integer arithmetic.
-10 # IntLog(_x, _base) _ (base<=1) <-- Undefined;
-/// Use variable steps to speed up operation for large numbers x
-20 # IntLog(_x, _base) <--
-[
- Local(result, step, old'step, factor, old'factor);
- result := 0;
- old'step := step := 1;
- old'factor := factor := base;
- // first loop: increase step
- While (x >= factor)
- [
- old'factor := factor;
- factor := factor*factor;
- old'step := step;
- step := step*2;
- ];
- If(x >= base,
- [
- step := old'step;
- result := step;
- x := Div(x, old'factor);
- ],
- step := 0
- );
- // second loop: decrease step
- While (step > 0 And x != 1)
- [
- step := Div(step,2); // for each step size down to 1, divide by factor if x is up to it
- factor := base^step;
- If(
- x >= factor,
- [
- x:=Div(x, factor);
- result := result + step;
- ]
- );
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IntLog"
-*CMD IntLog --- integer part of logarithm
-*STD
-*CALL
- IntLog(n, base)
-
-*PARMS
-
-{n}, {base} -- positive integers
-
-*DESC
-
-{IntLog} calculates the integer part of the logarithm of {n} in base {base}. The algorithm uses only integer math and may be faster than computing $$Ln(n)/Ln(base)$$ with multiple precision floating-point math and rounding off to get the integer part.
-
-This function can also be used to quickly count the digits in a given number.
-
-*E.G.
-Count the number of bits:
- In> IntLog(257^8, 2)
- Out> 64;
-
-Count the number of decimal digits:
- In> IntLog(321^321, 10)
- Out> 804;
-
-*SEE IntNthRoot, Div, Mod, Ln
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IntNthRoot.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IntNthRoot.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IntNthRoot.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IntNthRoot.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,104 +0,0 @@
-%mathpiper,def="IntNthRoot"
-
-/// Compute integer part of s-th root of (positive) integer n.
-// algorithm using floating-point math
-10 # IntNthRoot(_n, 2) <-- Floor(SqrtN(n));
-20 # IntNthRoot(_n, s_IsInteger) <--
-[
- Local(result, k);
- GlobalPush(BuiltinPrecisionGet());
- // find integer k such that 2^k <= n^(1/s) < 2^(k+1)
- k := Div(IntLog(n, 2), s);
- // therefore we need k*Ln(2)/Ln(10) digits for the floating-point calculation
- BuiltinPrecisionSet(2+Div(k*3361, 11165)); // 643/2136 < Ln(2)/Ln(10) < 3361/11165
- result := Round(ExpN(DivideN(Internal'LnNum(DivideN(n, 2^(k*s))), s))*2^k);
- BuiltinPrecisionSet(GlobalPop());
- // result is rounded and so it may overshoot (we do not use Floor above because numerical calculations may undershoot)
- If(result^s>n, result-1, result);
-];
-
-/* algorithm using only integer arithmetic.
-(this is slower than the floating-point algorithm for large numbers because all calculations are with long integers)
-IntNthRoot1(_n, s_IsInteger) <--
-[
- Local(x1, x2, x'new, y1);
- // initial guess should always undershoot
- // x1:= 2 ^ Div(IntLog(n, 2), s); // this is worse than we can make it
- x1 := IntLog(n,2);
- // select initial interval using (the number of bits in n) mod s
- // note that if the answer is 1, the initial guess must also be 1 (not 0)
- x2 := Div(x1, s); // save these values for the next If()
- x1 := Mod(x1, s)/s; // this is kept as a fraction
- // now assign the initial interval, x1 <= root <= x2
- {x1, x2} := If(
- x1 >= 263/290, // > Ln(15/8)/Ln(2)
- Div({15,16}*2^x2, 8),
- If(
- x1 >= 373/462, // > Ln(7/4)/Ln(2)
- Div({7,8}*2^x2, 4),
- If(
- x1 >= 179/306, // > Ln(3/2)/Ln(2)
- Div({6,7}*2^x2, 4),
- If(
- x1 >= 113/351, // > Ln(5/4)/Ln(2)
- Div({5,6}*2^x2, 4),
- Div({4,5}*2^x2, 4) // between x1 and (5/4)*x1
- ))));
- // check whether x2 is the root
- y1 := x2^s;
- If(
- y1=n,
- x1 := x2,
- // x2 is not a root, so continue as before with x1
- y1 := x1^s // henceforth, y1 is always x1^s
- );
- // Newton iteration combined with bisection
- While(y1 < n)
- [
-// Echo({x1, x2});
- x'new := Div(x1*((s-1)*y1+(s+1)*n), (s+1)*y1+(s-1)*n) + 1; // add 1 because the floating-point value undershoots
- If(
- x'new < Div(x1+x2, 2),
- // x'new did not reach the midpoint, need to check progress
- If(
- Div(x1+x2, 2)^s <= n,
- // Newton's iteration is not making good progress, so leave x2 in place and update x1 by bisection
- x'new := Div(x1+x2, 2),
- // Newton's iteration knows what it is doing. Update x2 by bisection
- x2 := Div(x1+x2, 2)
- )
- // else, x'new reached the midpoint, good progress, continue
- );
- x1 := x'new;
- y1 := x1^s;
- ];
- If(y1=n, x1, x1-1); // subtract 1 if we overshot
-];
-*/
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IntNthRoot"
-*CMD IntNthRoot --- integer part of $n$-th root
-*STD
-*CALL
- IntNthRoot(x, n)
-
-*PARMS
-
-{x}, {n} -- positive integers
-
-*DESC
-
-{IntNthRoot} calculates the integer part of the $n$-th root of $x$. The algorithm uses only integer math and may be faster than computing $x^(1/n)$ with floating-point and rounding.
-
-This function is used to test numbers for prime powers.
-
-*E.G.
- In> IntNthRoot(65537^111, 37)
- Out> 281487861809153;
-
-*SEE IntLog, MathPower, IsPrimePower
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsAmicablePair.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsAmicablePair.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsAmicablePair.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsAmicablePair.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsAmicablePair"
-
-IsAmicablePair(m_IsPositiveInteger,n_IsPositiveInteger) <-- ( ProperDivisorsSum(m)=n And ProperDivisorsSum(n)=m );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsAmicablePair",categories="User Functions;Number Theory;Predicates"
-*CMD IsAmicablePair --- test for a pair of amicable numbers
-*STD
-*CALL
- IsAmicablePair(m,n)
-
-*PARMS
-
-{m}, {n} -- positive integers
-
-*DESC
-
-This function tests if a pair of numbers are amicable. A pair of
-numbers $m$, $n$ has this property if the sum of the proper divisors of $m$ is
-$n$ and the sum of the proper divisors of $n$ is $m$.
-
-*E.G.
-
- In> IsAmicablePair(200958394875, 209194708485 )
- Out> True;
- In> IsAmicablePair(220, 284)
- Out> True;
-
-*SEE ProperDivisorsSum
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsCarmichaelNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsCarmichaelNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsCarmichaelNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsCarmichaelNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,60 +0,0 @@
-%mathpiper,def="IsCarmichaelNumber"
-
-// Carmichael numbers are odd,squarefree and have at least 3 prime factors
-5 # IsCarmichaelNumber(n_IsEven) <-- False;
-5 # IsCarmichaelNumber(_n)_(n<561) <-- False;
-10 # IsCarmichaelNumber(n_IsPositiveInteger) <--
-[
- Local(i,factors,length,carmichael);
-
- factors:=Factors(n);
- carmichael:=True;
- length:=Length(factors);
- if( length < 3)[
- carmichael:=False;
- ] else [
- For(i:=1,i<=length And carmichael,i++)[
- //Echo( n-1,"%",factors[i][1]-1,"=", Mod(n-1,factors[i][1]-1) );
- If( Mod(n-1,factors[i][1]-1) != 0, carmichael:=False );
- If(factors[i][2]>1,carmichael:=False); // squarefree
- ];
- ];
- carmichael;
-];
-
-IsCarmichaelNumber(n_IsList) <-- MapSingle("IsCarmichaelNumber",n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsCarmichaelNumber",categories="User Functions;Number Theory;Predicates"
-*CMD IsCarmichaelNumber --- test for a Carmichael number
-*STD
-*CALL
- IsCarmichaelNumber(n)
-
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function returns {True} if {n} is a Carmichael number, also called an absolute pseudoprime.
-They have the property that $ b^(n-1) % n == 1 $ for all $b$ satisfying $Gcd(b,n)==1$. These numbers
-cannot be proved composite by Fermat's little theorem. Because the previous property is extremely
-slow to test, the following equivalent property is tested by MathPiper: for all prime factors $p[i]$ of $n$,
-$(n-1) % (p[i] - 1) == 0$ and $n$ must be square free. Also, Carmichael numbers must be odd and have
-at least three prime factors. Although these numbers are rare (there are only 43 such numbers between $1$ and $10^6$),
-it has recently been proven that there are infinitely many of them.
-
-*E.G. notest
-
- In> IsCarmichaelNumber(561)
- Out> True;
- In> EchoTime() Select(IsCarmichaelNumber,1 .. 10000)
- 504.19 seconds taken
- Out> {561,1105,1729,2465,2821,6601,8911};
-
-*SEE IsSquareFree, IsComposite
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsComposite.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsComposite.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsComposite.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsComposite.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="IsComposite"
-
-5 # IsComposite(1) <-- False;
-10 # IsComposite(n_IsPositiveInteger) <-- (Not IsPrime(n));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsComposite",categories="User Functions;Number Theory;Predicates"
-*CMD IsComposite --- test for a composite number
-*STD
-*CALL
- IsComposite(n)
-
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function is the logical negation of {IsPrime}, except for the number 1, which is
-neither prime nor composite.
-
-*E.G.
-
- In> IsComposite(1)
- Out> False;
- In> IsComposite(7)
- Out> False;
- In> IsComposite(8)
- Out> True;
- In> Select(IsComposite,1 .. 20)
- Out> {4,6,8,9,10,12,14,15,16,18,20};
-
-*SEE IsPrime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsCoprime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsCoprime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsCoprime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsCoprime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="IsCoprime"
-
-5 # IsCoprime(list_IsList) <-- (Lcm(list) = Product(list));
-10 # IsCoprime(n_IsInteger,m_IsInteger) <-- (Gcd(n,m) = 1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsCoprime",categories="User Functions;Number Theory;Predicates"
-*CMD IsCoprime --- test if integers are coprime
-*STD
-*CALL
- IsCoprime(m,n)
- IsCoprime(list)
-*PARMS
-
-{m},{n} -- positive integers
-
-{list} -- list of positive integers
-
-*DESC
-
-This function returns {True} if the given pair or list of integers are coprime,
-also called relatively prime. A pair or list of numbers are coprime if they
-share no common factors.
-
-*E.G.
-
- In> IsCoprime({3,4,5,8})
- Out> False;
- In> IsCoprime(15,17)
- Out> True;
-
-*SEE Prime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsIrregularPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsIrregularPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsIrregularPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsIrregularPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,53 +0,0 @@
-%mathpiper,def="IsIrregularPrime"
-
-5 # IsIrregularPrime(p_IsComposite) <-- False;
-// First irregular prime is 37
-5 # IsIrregularPrime(_p)_(p<37) <-- False;
-
-// an odd prime p is irregular iff p divides the numerator of a Bernoulli number B(2*n) with
-// 2*n+1
IsIrregularPrime(5)
- Out> False;
- In> Select(IsIrregularPrime,1 .. 100)
- Out> {37,59,67};
-
-*SEE IsPrime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPerfect.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPerfect.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPerfect.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPerfect.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsPerfect"
-
-IsPerfect(n_IsPositiveInteger) <-- ProperDivisorsSum(n)=n;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,63 +0,0 @@
-%mathpiper,def="IsPrime",categories="User Functions;Number Theory"
-
-2 # IsPrime(_n)_(Not IsInteger(n) Or n<=1) <-- False;
-3 # IsPrime(n_IsInteger)_(n<=FastIsPrime(0)) <-- IsSmallPrime(n);
-
-/* Fast pseudoprime testing: if n is a prime, then 24 divides (n^2-1) */
-5 # IsPrime(n_IsPositiveInteger)_(n > 4 And Mod(n^2-1,24)!=0) <-- False;
-
-/* Determine if a number is prime, using Rabin-Miller primality
- testing. Code submitted by Christian Obrecht
- */
-10 # IsPrime(n_IsPositiveInteger) <-- RabinMiller(n);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsPrime",categories="User Functions;Number Theory;Predicates"
-*CMD IsPrime --- test for a prime number
-*CMD IsSmallPrime --- test for a (small) prime number
-*STD
-*CALL
- IsPrime(n)
- IsSmallPrime(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-The commands checks whether $n$, which should be a positive integer,
-is a prime number. A number $n$ is a prime number if it is only divisible
-by 1 and itself. As a special case, 1 is not considered a prime number.
-The first prime numbers are 2, 3, 5, ...
-
-The function {IsShortPrime} only works for numbers $n<=65537$ but it is very fast.
-
-The function {IsPrime} operates on all numbers and uses different algorithms depending on the magnitude of the number $n$.
-For small numbers $n<=65537$, a constant-time table lookup is performed.
-(The function {IsShortPrime} is used for that.)
-For numbers $n$ between $65537$ and $34155071728321$, the function uses the Rabin-Miller test together with table lookups to guarantee correct results.
-
-For even larger numbers a version of the probabilistic Rabin-Miller test is executed.
-The test can sometimes mistakenly mark a number as prime while it is in fact composite, but a prime number will never be mistakenly declared composite.
-The parameters of the test are such that the probability for a false result is less than $10^(-24)$.
-
-*E.G.
-
- In> IsPrime(1)
- Out> False;
- In> IsPrime(2)
- Out> True;
- In> IsPrime(10)
- Out> False;
- In> IsPrime(23)
- Out> True;
- In> Select("IsPrime", 1 .. 100)
- Out> {2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,
- 53,59,61,67,71,73,79,83,89,97};
-
-*SEE IsPrimePower, Factors
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPrimePower.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPrimePower.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsPrimePower.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsPrimePower.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="IsPrimePower"
-
-/* Returns whether n is a prime^m. */
-10 # IsPrimePower(n_IsPrime) <-- True;
-10 # IsPrimePower(0) <-- False;
-10 # IsPrimePower(1) <-- False;
-20 # IsPrimePower(n_IsPositiveInteger) <-- (GetPrimePower(n)[2] > 1);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsPrimePower",categories="User Functions;Number Theory;Predicates"
-*CMD IsPrimePower --- test for a power of a prime number
-*STD
-*CALL
- IsPrimePower(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This command tests whether "n", which should be a positive integer,
-is a prime power, that is whether it is of the form $p^m$, with
-"p" prime and "m" an integer.
-
-This function does not try to decompose the number $n$ into factors.
-Instead we check for all prime numbers $r=2$, $3$, ... that the $r$-th root of $n$ is an integer, and we find such $r$ and $m$ that $n=m^r$, we check that $m$ is a prime. If it is not a prime, we execute the same function call on $m$.
-
-*E.G.
-
- In> IsPrimePower(9)
- Out> True;
- In> IsPrimePower(10)
- Out> False;
- In> Select("IsPrimePower", 1 .. 50)
- Out> {2,3,4,5,7,8,9,11,13,16,17,19,23,25,27,
- 29,31,32,37,41,43,47,49};
-
-*SEE IsPrime, Factors
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsQuadraticResidue.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsQuadraticResidue.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsQuadraticResidue.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsQuadraticResidue.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="IsQuadraticResidue"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Theorem 9.1 p187
-10 # IsQuadraticResidue(_a,_p) <--
-[
- Check( IsInteger(a) And IsInteger(p) And p>2 And IsCoprime(a,p) And IsPrime(p),
- "IsQuadraticResidue: Invalid arguments");
- If(a^((p-1)/2) % p = 1, True, False);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsQuadraticResidue",categories="User Functions;Number Theory;Predicates"
-*CMD IsQuadraticResidue --- functions related to finite groups
-*STD
-*CALL
- IsQuadraticResidue(m,n)
-
-*PARMS
-{m}, {n} -- integers, $n$ must be odd and positive
-
-*DESC
-
-A number $m$ is a "quadratic residue modulo $n$" if there exists a number $k$ such that $k^2:=Mod(m,n)$.
-
-*E.G.
-
- In> IsQuadraticResidue(9,13)
- Out> True;
-
-*SEE Gcd, JacobiSymbol, LegendreSymbol
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsSmallPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsSmallPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsSmallPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsSmallPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,58 +0,0 @@
-%mathpiper,def="IsSmallPrime"
-
-/* Returns whether n is a small by a lookup table, very fast.
-The largest prime number in the table is returned by FastIsPrime(0). */
-
-2 # IsSmallPrime(0) <-- False;
-3 # IsSmallPrime(n_IsInteger) <-- (FastIsPrime(n)>0);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsSmallPrime",categories="User Functions;Number Theory;Predicates"
-*CMD IsPrime --- test for a prime number
-*CMD IsSmallPrime --- test for a (small) prime number
-*STD
-*CALL
- IsPrime(n)
- IsSmallPrime(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-The commands checks whether $n$, which should be a positive integer,
-is a prime number. A number $n$ is a prime number if it is only divisible
-by 1 and itself. As a special case, 1 is not considered a prime number.
-The first prime numbers are 2, 3, 5, ...
-
-The function {IsShortPrime} only works for numbers $n<=65537$ but it is very fast.
-
-The function {IsPrime} operates on all numbers and uses different algorithms depending on the magnitude of the number $n$.
-For small numbers $n<=65537$, a constant-time table lookup is performed.
-(The function {IsShortPrime} is used for that.)
-For numbers $n$ between $65537$ and $34155071728321$, the function uses the Rabin-Miller test together with table lookups to guarantee correct results.
-
-For even larger numbers a version of the probabilistic Rabin-Miller test is executed.
-The test can sometimes mistakenly mark a number as prime while it is in fact composite, but a prime number will never be mistakenly declared composite.
-The parameters of the test are such that the probability for a false result is less than $10^(-24)$.
-
-*E.G.
-
- In> IsPrime(1)
- Out> False;
- In> IsPrime(2)
- Out> True;
- In> IsPrime(10)
- Out> False;
- In> IsPrime(23)
- Out> True;
- In> Select("IsPrime", 1 .. 100)
- Out> {2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,
- 53,59,61,67,71,73,79,83,89,97};
-
-*SEE IsPrimePower, Factors
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsSquareFree.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsSquareFree.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsSquareFree.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsSquareFree.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="IsSquareFree"
-
-IsSquareFree(n_IsInteger) <-- ( Moebius(n) != 0 );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsSquareFree",categories="User Functions;Number Theory;Predicates"
-*CMD IsSquareFree --- test for a square-free number
-*STD
-*CALL
- IsSquareFree(n)
-
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function uses the {Moebius} function to tell if the given number is square-free, which
-means it has distinct prime factors. If $Moebius(n)!=0$, then {n} is square free. All prime
-numbers are trivially square-free.
-
-*E.G.
-
- In> IsSquareFree(37)
- Out> True;
- In> IsSquareFree(4)
- Out> False;
- In> IsSquareFree(16)
- Out> False;
- In> IsSquareFree(18)
- Out> False;
-
-*SEE Moebius, SquareFreeDivisorsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsTwinPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsTwinPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/IsTwinPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/IsTwinPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="IsTwinPrime"
-
-IsTwinPrime(n_IsPositiveInteger) <-- (IsPrime(n) And IsPrime(n+2));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsTwinPrime",categories="User Functions;Number Theory;Predicates"
-*CMD IsTwinPrime --- test for a twin prime
-*STD
-*CALL
- IsTwinPrime(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-This function returns {True} if {n} is a twin prime. By definition, a twin
-prime is a prime number $n$ such that $n+2$ is also a prime number.
-
-*E.G.
- In> IsTwinPrime(101)
- Out> True;
- In> IsTwinPrime(7)
- Out> False;
- In> Select(IsTwinPrime, 1 .. 100)
- Out> {3,5,11,17,29,41,59,71};
-
-*SEE IsPrime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/LegendreSymbol.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/LegendreSymbol.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/LegendreSymbol.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/LegendreSymbol.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="LegendreSymbol"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Definition 9.2 p191
-
-10 # LegendreSymbol(_a,_p) <--
-[
- Check( IsInteger(a) And IsInteger(p) And p>2 And IsCoprime(a,p) And IsPrime(p),
- "LegendreSymbol: Invalid arguments");
- If(IsQuadraticResidue(a,p), 1, -1 );
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="LegendreSymbol",categories="User Functions;Number Theory"
-*CMD LegendreSymbol --- functions related to finite groups
-*STD
-*CALL
- LegendreSymbol(m,n)
-
-*PARMS
-{m}, {n} -- integers, $n$ must be odd and positive
-
-*DESC
-
-The Legendre symbol ($m$/$n$) is defined as $+1$ if $m$ is a quadratic residue modulo $n$ and $-1$ if it is a non-residue.
-The Legendre symbol is equal to $0$ if $m/n$ is an integer.
-
-*E.G.
-
- In> IsQuadraticResidue(9,13)
- Out> True;
- In> LegendreSymbol(15,23)
- Out> -1;
- In> JacobiSymbol(7,15)
- Out> -1;
-
-*SEE Gcd, JacobiSymbol, IsQuadraticResidue
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Moebius.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Moebius.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Moebius.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Moebius.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-%mathpiper,def="Moebius"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Definition 6.3 p120
-
-5 # Moebius(1) <-- 1;
-
-10 # Moebius(_n) <--
-[
- Check(IsPositiveInteger(n),
- "Moebius: argument must be positive integer");
- Local(factors,i,repeat);
- repeat:=0;
- factors:=Factors(n);
- len:=Length(factors);
- For(i:=1,i<=len,i++)[
- If(factors[i][2]>1,repeat:=1);
- ];
- If(repeat=0,(-1)^len,0);
-
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="Moebius",categories="User Functions;Number Theory"
-*CMD Moebius --- the Moebius function
-*STD
-*CALL
- Moebius(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-The Moebius function is 0 when a prime factor is repeated (which means it
-is not square-free) and is $(-1)^r$ if $n$ has $r$ distinct factors. Also,
-$Moebius(1)==1$.
-
-*E.G.
- In> Moebius(10)
- Out> 1;
- In> Moebius(11)
- Out> -1;
- In> Moebius(12)
- Out> 0;
- In> Moebius(13)
- Out> -1;
-
-*SEE DivisorsSum, ProperDivisors, ProperDivisorsSum, MoebiusDivisorsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/NextPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/NextPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/NextPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/NextPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="NextPrime"
-
-/// obtain the real next prime number -- use primality testing
-1# NextPrime(_i) <--
-[
- Until(IsPrime(i)) i := NextPseudoPrime(i);
- i;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="NextPrime",categories="User Functions;Number Theory"
-*CMD NextPrime --- generate a prime following a number
-*STD
-*CALL
- NextPrime(i)
-
-*PARMS
-
-{i} -- integer value
-
-*DESC
-
-The function finds the smallest prime number that is greater than the given
-integer value.
-
-The routine generates "candidate numbers" using the formula $n+2*Mod(-n,3)$
-where $n$ is an odd number (this generates the sequence 5, 7, 11, 13, 17,
-19, ...) and {IsPrime()} to test whether the next candidate number is in
-fact prime.
-
-*E.G.
- In> NextPrime(5)
- Out> 7;
-
-*SEE IsPrime
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/NextPseudoPrime.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/NextPseudoPrime.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/NextPseudoPrime.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/NextPseudoPrime.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,30 +0,0 @@
-%mathpiper,def="NextPseudoPrime"
-
-/// obtain next number that has good chances of being prime (not divisible by 2,3)
-1# NextPseudoPrime(i_IsInteger)_(i<=1) <-- 2;
-2# NextPseudoPrime(2) <-- 3;
-//2# NextPseudoPrime(3) <-- 5;
-3# NextPseudoPrime(i_IsOdd) <--
-[
- // this sequence generates numbers not divisible by 2 or 3
- i := i+2;
- If(Mod(i,3)=0, i:=i+2, i);
-/* commented out because it slows things down without a real advantage
-// this works only for odd i>=5
- i := If(
- Mod(-i,3)=0,
- i + 2,
- i + 2*Mod(-i, 3)
- );
- // now check if divisible by 5
- If(
- Mod(i,5)=0,
- NextPseudoPrime(i),
- i
- );
-*/
-];
-// this works only for even i>=4
-4# NextPseudoPrime(i_IsEven) <-- NextPseudoPrime(i-1);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/nthroot/nthroot.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/nthroot/nthroot.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/nthroot/nthroot.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/nthroot/nthroot.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,179 +0,0 @@
-%mathpiper,def="NthRoot;NthRoot'Calc;NthRoot'List;NthRoot'Save;NthRoot'Restore;NthRoot'Clear"
-
-/* def file definitions
-NthRoot
-NthRoot'Calc
-NthRoot'List
-NthRoot'Save
-NthRoot'Restore
-NthRoot'Clear
-
-*/
-
-//////
-// $Id: nthroot.mpi,v 1.5 2007/05/17 11:56:45 ayalpinkus Exp $
-// calculation/simplifaction of nth roots of nonnegative integers
-// NthRoot - interface function
-// NthRoot'Calc - actually calculate/simplifies
-// NthRoot'List - list table entries for a given n
-// NthRoot'Restore - get a root from lookup table
-// NthRoot'Save - save a root in lookup table
-// NthRoot'Clear - clear lookup table
-//////
-
-// LocalSymbols(m,n,r,
-// NthRoot'Table,
-// NthRoot'Calc,
-// NthRoot'List,
-// NthRoot'Restore,
-// NthRoot'Save,
-// NthRoot'Clear)
-LocalSymbols(m,n,r,
- NthRoot'Table)
-[
-
-// interface function for nth root of m
-// m>=0, n>1, integers
-// m^(1/n) --> f*(r^(1/n))
-NthRoot(m_IsNonNegativeInteger,n_IsInteger)_(n>1) <--
-[
- Local(r);
- r:=NthRoot'Restore(m,n);
- If(Length(r)=0,
- [
- r:=NthRoot'Calc(m,n);
- NthRoot'Save(m,n,r);
- ]);
- r;
-];
-
-// internal functions
-Function("NthRoot'Calc",{m,n})
-[
- Local(i,j,f,r,in);
- Set(i,2);
- Set(j,Ceil(FastPower(m,N(1.0/n))+1));
- Set(f,1);
- Set(r,m);
- // for large j (approx >4000)
- // using Factors instead of the
- // following. would this be
- // faster in general?
-//Echo("i j ",i," ",j);
- While(LessThan(i,j))
- [
- Set(in,PowerN(i,n));
-//Echo("r in mod ",r, " ",in," ",ModN(r,in));
- While(Equals(ModN(r,in),0))
- [
- Set(f,MultiplyN(f,i));
- Set(r,DivN(r,in));
- ];
- While(Equals(ModN(r,i),0)) //
- Set(r,DivN(r,i)); //
- //Set(i,NextPrime(i));
- Set(i,NextPseudoPrime(i));
- Set(j,Ceil(FastPower(r,N(1.0/n))+1));
- ];
- //List(f,r);
- List(f,DivN(m,PowerN(f,n))); //
-];
-
-// lookup table utilities
-Function("NthRoot'List",{n})
-[
- If(Length(NthRoot'Table)>0,
- [
- Local(p,xx);
- p:=Select({{xx},First(xx)=n},NthRoot'Table);
- If(Length(p)=1,Rest(p[1]),List());
- ],
- List());
-];
-
-Function("NthRoot'Restore",{m,n})
-[
- Local(p);
- p:=NthRoot'List(n);
- If(Length(p)>0,
- [
- Local(r,xx);
- r:=Select({{xx},First(xx)=m},p);
- If(Length(r)=1,First(Rest(r[1])),List());
- ],
- List());
-];
-
-Function("NthRoot'Save",{m,n,r})
-[
- Local(p);
- p:=NthRoot'List(n);
- If(Length(p)=0,
- // create power list and save root
- DestructiveInsert(NthRoot'Table,1,List(n,List(m,r))),
- [
- Local(rr,xx);
- rr:=Select({{xx},First(xx)=m},p);
- If(Length(rr)=0,
- [
- // save root only
- DestructiveAppend(p,List(m,r));
- ],
- // already saved
- False);
- ]);
-];
-
-//TODO why is NthRoot'Table both lazy global and protected with LocalSymbols?
-Function("NthRoot'Clear",{}) SetGlobalLazyVariable(NthRoot'Table,List());
-
-// create empty table
-NthRoot'Clear();
-
-]; // LocalSymbols(m,n,r,NthRoot'Table);
-
-//////
-//////
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="NthRoot"
-*CMD NthRoot --- calculate/simplify nth root of an integer
-*STD
-*CALL
- NthRoot(m,n)
-
-*PARMS
-
-{m} -- a non-negative integer ($m>0$)
-
-{n} -- a positive integer greater than 1 ($n>1$)
-
-*DESC
-
-{NthRoot(m,n)} calculates the integer part of the $n$-th root $m^(1/n)$ and
-returns a list {{f,r}}. {f} and {r} are both positive integers
-that satisfy $f^n*r$=$m$.
-In other words, $f$ is the largest integer such that $m$ divides $f^n$ and $r$ is the remaining factor.
-
-For large {m} and small {n}
-{NthRoot} may work quite slowly. Every result {{f,r}} for given
-{m}, {n} is saved in a lookup table, thus subsequent calls to
-{NthRoot} with the same values {m}, {n} will be executed quite
-fast.
-
-*E.G.
- In> NthRoot(12,2)
- Out> {2,3};
- In> NthRoot(81,3)
- Out> {3,3};
- In> NthRoot(3255552,2)
- Out> {144,157};
- In> NthRoot(3255552,3)
- Out> {12,1884};
-
-*SEE IntNthRoot, Factors, MathPower
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/DivisorsList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/DivisorsList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/DivisorsList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/DivisorsList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-%mathpiper,def="DivisorsList"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/* DivisorsList(n) = the list of divisors of n */
-
-DivisorsList(n_IsPositiveInteger) <--
-[
- Local(nFactors,f,result,oldresult,x);
- nFactors:= Factors(n);
- result := {1};
- ForEach (f,nFactors)
- [
- oldresult := result;
- For (k:=1,k<=f[2],k++)
- ForEach (x,oldresult)
- result:=Append(result,x*f[1]^k);
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="DivisorsList",categories="User Functions;Number Theory"
-*CMD DivisorsList --- the list of divisors
-*STD
-*CALL
- DivisorsList(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-{DivisorsList} creates a list of the divisors of $n$.
-This is useful for loops like
-
- ForEach(d,DivisorsList(n))
-
-*E.G.
-
- In> DivisorsList(18)
- Out> {1,2,3,6,9,18};
-
-*SEE DivisorsSum
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/JacobiSymbol.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/JacobiSymbol.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/JacobiSymbol.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/JacobiSymbol.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,57 +0,0 @@
-%mathpiper,def="JacobiSymbol"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/** Compute the Jacobi symbol JS(m/n) - n must be odd, both positive.
-See the Algo book for documentation.
-
-*/
-
-10 # JacobiSymbol(_a, 1) <-- 1;
-15 # JacobiSymbol(0, _b) <-- 0;
-18 # JacobiSymbol(_a, _b) _ (Gcd(a,b)>1) <-- 0;
-
-20 # JacobiSymbol(_a, b_IsOdd)_(a>=Abs(b) Or a<0) <-- JacobiSymbol(Mod(a,Abs(b)),Abs(b));
-
-30 # JacobiSymbol(a_IsEven, b_IsOdd) <--
-[
- Local(c, s);
- // compute c,s where a=c*2^s and c is odd
- {c,s}:=FindPrimeFactorSimple(a, 2); // use the "Simple" function because we don't expect a worst case here
- If(Mod(s,2)=1 And Abs(Mod(b,8)-4)=1, -1, 1) * JacobiSymbol(c,b);
-];
-
-40 # JacobiSymbol(a_IsOdd, b_IsOdd) <-- If(Mod(a,4)=3 And Mod(b,4)=3, -1, 1) * JacobiSymbol(b,a);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="JacobiSymbol",categories="User Functions;Number Theory"
-*CMD JacobiSymbol --- functions related to finite groups
-*STD
-*CALL
- JacobiSymbol(m,n)
-
-*PARMS
-{m}, {n} -- integers, $n$ must be odd and positive
-
-*DESC
-
-The Jacobi symbol $[m/n;]$ is defined as the product of the Legendre symbols of the prime factors $f[i]$ of $n=f[1]^p[1]*...*f[s]^p[s]$,
-$$ [m/n;] := [m/f[1];]^p[1]*...*[m/f[s];]^p[s] $$.
-(Here we used the same notation $[a/b;]$ for the Legendre and the Jacobi symbols; this is confusing but seems to be the current practice.)
-The Jacobi symbol is equal to $0$ if $m$, $n$ are not mutually prime (have a common factor).
-The Jacobi symbol and the Legendre symbol have values $+1$, $-1$ or $0$.
-If $n$ is prime, then the Jacobi symbol is the same as the Legendre symbol.
-
-The Jacobi symbol can be efficiently computed without knowing the full factorization of the number $n$.
-
-*E.G.
-
- In> JacobiSymbol(7,15)
- Out> -1;
-
-*SEE Gcd, LegendreSymbol, IsQuadraticResidue
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/MoebiusDivisorsList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/MoebiusDivisorsList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/MoebiusDivisorsList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/MoebiusDivisorsList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,56 +0,0 @@
-%mathpiper,def="MoebiusDivisorsList"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/* Returns a list of pairs {d,m}
- where d runs through the square free divisors of n
- and m=Moebius(m)
- This is much more efficient than making a list of all
- square-free divisors of n, and then compute Moebius on each of them.
- It is useful for computing the Cyclotomic polinomials.
- It can be useful in other computations based on
- Moebius inversion formula. */
-
-MoebiusDivisorsList(n_IsPositiveInteger) <--
-[
- Local(nFactors,f,result,oldresult,x);
- nFactors:= Factors(n);
- result := {{1,1}};
- ForEach (f,nFactors)
- [
- oldresult := result;
- ForEach (x,oldresult)
- result:=Append(result,{x[1]*f[1],-x[2]});
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="MoebiusDivisorsList",categories="User Functions;Number Theory"
-*CMD MoebiusDivisorsList --- the list of divisors and Moebius values
-*STD
-*CALL
- MoebiusDivisorsList(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-Returns a list of pairs of the form {{d,m}}, where {d} runs through the squarefree divisors of $n$ and $m=Moebius(d)$.
-This is more efficient than making a list of all
-square-free divisors of $n$ and then computing {Moebius} on each of them.
-It is useful for computing the cyclotomic polynomials.
-It can be useful in other computations based on the Moebius inversion formula.
-
-*E.G.
-
- In> MoebiusDivisorsList(18)
- Out> {{1,1},{2,-1},{3,-1},{6,1}};
-
-*SEE DivisorsList, Moebius
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/RamanujanSum.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/RamanujanSum.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/RamanujanSum.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/RamanujanSum.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="RamanujanSum"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/* RamanujanSum(k,n) = the sum of the n-th powers of the
-k-th primitive roots of the identity */
-
-10 # RamanujanSum(k_IsPositiveInteger,0) <-- Totient(k);
-
-20 # RamanujanSum(k_IsPositiveInteger,n_IsPositiveInteger) <--
-[
- Local(s,gcd,d);
- s:= 0;
- gcd := Gcd(n,k);
- ForEach (d,DivisorsList(gcd))
- s:=s+d*Moebius(k/d);
- s;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="RamanujanSum",categories="User Functions;Number Theory"
-*CMD RamanujanSum --- compute the "Ramanujan sum"
-*STD
-*CALL
- RamanujanSum(k,n)
-
-*PARMS
-
-{k}, {n} -- positive integers
-
-*DESC
-This function computes the Ramanujan sum, i.e. the sum of the $n$-th powers of
-the $k$-th primitive roots of the unit:
-
-$$ Sum(l,1,k, Exp(2*Pi*I*(l*n)/k)) $$
-
-where $l$ runs thought the integers between $1$ and $k-1$ that are coprime to $l$.
-
-The computation is done by using the formula in T. M. Apostol,
-Introduction to Analytic Theory (Springer-Verlag), Theorem 8.6.
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/SquareFreeDivisorsList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/SquareFreeDivisorsList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/SquareFreeDivisorsList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/SquareFreeDivisorsList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="SquareFreeDivisorsList"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/* Returns a list of the square-free divisors of n */
-SquareFreeDivisorsList(n_IsPositiveInteger) <--
-[
- Local(nFactors,f,result,oldresult,x);
- nFactors:= Factors(n);
- result := {1};
- ForEach (f,nFactors)
- [
- oldresult := result;
- ForEach (x,oldresult)
- result:=Append(result,x*f[1]);
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="SquareFreeDivisorsList",categories="User Functions;Number Theory"
-*CMD SquareFreeDivisorsList --- the list of square-free divisors
-*STD
-*CALL
- SquareFreeDivisorsList(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-{SquareFreeDivisorsList} creates a list of the square-free divisors of $n$.
-Square-free numbers are numbers that have only simple prime factors (no prime powers).
-For example, $18=2*3*3$ is not square-free because it contains a square of $3$ as a factor.
-
-*E.G.
-
- In> SquareFreeDivisorsList(18)
- Out> {1,2,3,6};
-
-*SEE DivisorsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/SumForDivisors.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/SumForDivisors.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/numbertheory/SumForDivisors.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/numbertheory/SumForDivisors.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,56 +0,0 @@
-%mathpiper,def="SumForDivisors"
-
-/* Implementation of some number theoretical functions for MathPiper */
-/* (C) 2002 Pablo De Napoli under GNU GPL */
-
-/* This function performs a sum where sumvar runs through
- the divisors of n
- For example SumForDivisors(d,10,d^2)
- sums d^2 with d walking through the divisors of 10
- LocalSymbols is needed since we use Eval() inside
- Look at Programming in MathPiper: Evaluating Variables in the Wrong
- Scope */
-
-Function ("SumForDivisors",{sumvar,n,sumbody}) LocalSymbols(s,d)
-[
- Local(s,d);
- s:=0;
- ForEach (d,DivisorsList(n))
- [
- MacroLocal(sumvar);
- MacroSet(sumvar,d);
- s:=s+Eval(sumbody);
- ];
- s;
-];
-UnFence("SumForDivisors",3);
-HoldArg("SumForDivisors",sumvar);
-HoldArg("SumForDivisors",sumbody);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="SumForDivisors",categories="User Functions;Number Theory"
-*CMD SumForDivisors --- loop over divisors
-*STD
-*CALL
- SumForDivisors(var,n,expr)
-*PARMS
-
-{var} -- atom, variable name
-
-{n} -- positive integer
-
-{expr} -- expression depending on {var}
-
-*DESC
-
-This function performs the sum of the values of the expression {expr} while the variable {var} runs through
-the divisors of {n}.
-For example, {SumForDivisors(d, 10, d^2)} sums $d^2$ where $d$ runs
-through the divisors of $10$.
-This kind of computation is frequently used in number theory.
-
-*SEE DivisorsList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/om/om.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/om/om.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/om/om.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/om/om.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-%mathpiper,def=""
-
-// From code.mpi.def:
-OMDef( "BellNumber", mathpiper,"BellNumber" );
-OMDef( "CatalanNumber", mathpiper,"CatalanNumber" );
-OMDef( "DigitalRoot", mathpiper,"DigitalRoot" );
-OMDef( "Divisors", mathpiper,"Divisors" );
-OMDef( "DivisorsSum", mathpiper,"DivisorsSum" );
-OMDef( "Euler", mathpiper,"Euler" );
-OMDef( "EulerArray", mathpiper,"EulerArray" );
-OMDef( "Eulerian", mathpiper,"Eulerian" );
-OMDef( "FermatNumber", mathpiper,"FermatNumber" );
-OMDef( "GetPrimePower", mathpiper,"GetPrimePower" );
-OMDef( "HarmonicNumber", mathpiper,"HarmonicNumber" );
-OMDef( "IntLog", mathpiper,"IntLog" );
-OMDef( "IntNthRoot", mathpiper,"IntNthRoot" );
-OMDef( "IsAmicablePair", mathpiper,"IsAmicablePair" );
-OMDef( "IsCarmichaelNumber", mathpiper,"IsCarmichaelNumber" );
-OMDef( "IsComposite", mathpiper,"IsComposite" );
-OMDef( "IsCoprime", mathpiper,"IsCoprime" );
-OMDef( "IsIrregularPrime", mathpiper,"IsIrregularPrime" );
-OMDef( "IsPerfect", mathpiper,"IsPerfect" );
-OMDef( "IsPrime", mathpiper,"IsPrime" );
-OMDef( "IsPrimePower", mathpiper,"IsPrimePower" );
-OMDef( "IsQuadraticResidue", mathpiper,"IsQuadraticResidue" );
-OMDef( "IsSmallPrime", mathpiper,"IsSmallPrime" );
-OMDef( "IsSquareFree", mathpiper,"IsSquareFree" );
-OMDef( "IsTwinPrime", mathpiper,"IsTwinPrime" );
-OMDef( "LegendreSymbol", mathpiper,"LegendreSymbol" );
-OMDef( "Moebius", mathpiper,"Moebius" );
-OMDef( "NextPrime", mathpiper,"NextPrime" );
-OMDef( "NextPseudoPrime", mathpiper,"NextPseudoPrime" );
-OMDef( "PartitionsP", mathpiper,"PartitionsP" );
-OMDef( "ProductPrimesTo257", mathpiper,"ProductPrimesTo257" );
-OMDef( "ProperDivisors", mathpiper,"ProperDivisors" );
-OMDef( "ProperDivisorsSum", mathpiper,"ProperDivisorsSum" );
-OMDef( "Repunit", mathpiper,"Repunit" );
-OMDef( "StirlingNumber1", mathpiper,"StirlingNumber1" );
-OMDef( "StirlingNumber2", mathpiper,"StirlingNumber2" );
-OMDef( "Totient", mathpiper,"Totient" );
-
-// From GaussianIntegers.mpi.def
-OMDef( "IsGaussianUnit", mathpiper,"IsGaussianUnit" );
-OMDef( "IsGaussianInteger", mathpiper,"IsGaussianInteger" );
-OMDef( "IsGaussianPrime", mathpiper,"IsGaussianPrime" );
-OMDef( "GaussianFactorPrime", mathpiper,"GaussianFactorPrime" );
-OMDef( "GaussianNorm", mathpiper,"GaussianNorm" );
-OMDef( "GaussianMod", mathpiper,"GaussianMod" );
-OMDef( "GaussianFactors", mathpiper,"GaussianFactors" );
-OMDef( "AddGaussianFactor", mathpiper,"AddGaussianFactor" );
-OMDef( "FactorGaussianInteger", mathpiper,"FactorGaussianInteger" );
-OMDef( "GaussianGcd", mathpiper,"GaussianGcd" );
-
-// From nthroot.mpi.def
-OMDef( "NthRoot", mathpiper,"NthRoot" );
-OMDef( "NthRoot'Calc", mathpiper,"NthRoot'Calc" );
-OMDef( "NthRoot'List", mathpiper,"NthRoot'List" );
-OMDef( "NthRoot'Save", mathpiper,"NthRoot'Save" );
-OMDef( "NthRoot'Restore", mathpiper,"NthRoot'Restore" );
-OMDef( "NthRoot'Clear", mathpiper,"NthRoot'Clear" );
-
-// From NumberTheory.mpi.def
-OMDef( "DivisorsList", mathpiper,"DivisorsList" );
-OMDef( "SquareFreeDivisorsList", mathpiper,"SquareFreeDivisorsList" );
-OMDef( "MoebiusDivisorsList", mathpiper,"MoebiusDivisorsList" );
-OMDef( "SumForDivisors", mathpiper,"SumForDivisors" );
-OMDef( "RamanujanSum", mathpiper,"RamanujanSum" );
-OMDef( "JacobiSymbol", mathpiper,"JacobiSymbol" );
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/PartitionsP.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/PartitionsP.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/PartitionsP.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/PartitionsP.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,151 +0,0 @@
-%mathpiper,def="PartitionsP"
-
-/// the restricted partition function
-/// partitions of length k
-
-5 # PartitionsP(n_IsInteger,0) <-- 0;
-5 # PartitionsP(n_IsInteger,n_IsInteger) <-- 1;
-5 # PartitionsP(n_IsInteger,1) <-- 1;
-5 # PartitionsP(n_IsInteger,2) <-- Floor(n/2);
-5 # PartitionsP(n_IsInteger,3) <-- Round(n^2/12);
-6 # PartitionsP(n_IsInteger,k_IsInteger)_(k>n) <-- 0;
-10 # PartitionsP(n_IsInteger,k_IsInteger) <-- PartitionsP(n-1,k-1)+PartitionsP(n-k,k);
-
-/// the number of additive partitions of an integer
-5 # PartitionsP(0) <-- 1;
-5 # PartitionsP(1) <-- 1;
-// decide which algorithm to use
-10 # PartitionsP(n_IsInteger)_(n<250) <-- PartitionsP'recur(n);
-20 # PartitionsP(n_IsInteger) <-- PartitionsP'HR(n);
-
-/// Calculation using the Hardy-Ramanujan series.
-10 # PartitionsP'HR(n_IsPositiveInteger) <--
-[
- Local(P0, A, lambda, mu, mu'k, result, term, j, k, l, prec, epsilon);
- result:=0;
- term:=1; // initial value must be nonzero
- GlobalPush(BuiltinPrecisionGet());
- // precision must be at least Pi/Ln(10)*Sqrt(2*n/3)-Ln(4*n*Sqrt(3))/Ln(10)
- // here Pi/Ln(10) < 161/118, and Ln(4*Sqrt(3))/Ln(10) <1 so it is disregarded. Add 2 guard digits and compensate for round-off errors by not subtracting Ln(n)/Ln(10) now
- prec := 2+Div(IntNthRoot(Div(2*n+2,3),2)*161+117,118);
- BuiltinPrecisionSet(prec); // compensate for round-off errors
- epsilon := PowerN(10,-prec)*n*10; // stop when term < epsilon
-
- // get the leading term approximation P0 - compute once at high precision
- lambda := N(Sqrt(n - 1/24));
- mu := N(Pi*lambda*Sqrt(2/3));
- // the hoops with DivideN are needed to avoid roundoff error at large n due to fixed precision:
- // Exp(mu)/(n) must be computed by dividing by n, not by multiplying by 1/n
- P0 := N(1-1/mu)*DivideN(ExpN(mu),(n-DivideN(1,24))*4*SqrtN(3));
- /*
- the series is now equal to
- P0*Sum(k,1,Infinity,
- (
- Exp(mu*(1/k-1))*(1/k-1/mu) + Exp(-mu*(1/k+1))*(1/k+1/mu)
- ) * A(k,n) * Sqrt(k)
- )
- */
-
- A := 0; // this is also used as a flag
- // this is a heuristic, because the next term error is expensive
- // to calculate and the theoretic bounds have arbitrary constants
- // use at most 5+Sqrt(n)/2 terms, stop when the term is nonzero and result stops to change at precision prec
- For(k:=1, k<=5+Div(IntNthRoot(n,2),2) And (A=0 Or Abs(term)>epsilon), k++)
- [
- // compute A(k,n)
- A:=0;
- For(l:=1,l<=k,l++)
- [
- If(
- Gcd(l,k)=1,
- A := A + Cos(Pi*
- ( // replace Exp(I*Pi*...) by Cos(Pi*...) since the imaginary part always cancels
- Sum(j,1,k-1, j*(Mod(l*j,k)/k-1/2)) - 2*l*n
- // replace (x/y - Floor(x/y)) by Mod(x,y)/y for integer x,y
- )/k)
- );
- A:=N(A); // avoid accumulating symbolic Cos() expressions
- ];
-
- term := If(
- A=0, // avoid long calculations if the term is 0
- 0,
- N( A*Sqrt(k)*(
- [
- mu'k := mu/k; // save time, compute mu/k once
- Exp(mu'k-mu)*(mu'k-1) + Exp(-mu'k-mu)*(mu'k+1);
- ]
- )/(mu-1) )
- );
-// Echo("k=", k, "term=", term);
- result := result + term;
-// Echo("result", new'result* P0);
- ];
- result := result * P0;
- BuiltinPrecisionSet(GlobalPop());
- Round(result);
-];
-
-// old code for comparison
-
-10 # PartitionsP1(n_IsPositiveInteger) <--
- [
- Local(C,A,lambda,m,pa,k,h,term);
- GlobalPush(BuiltinPrecisionGet());
- // this is an overshoot, but seems to work up to at least n=4096
- BuiltinPrecisionSet(10 + Floor(N(Sqrt(n))) );
- pa:=0;
- C:=Pi*Sqrt(2/3)/k;
- lambda:=Sqrt(m - 1/24);
- term:=1;
- // this is a heuristic, because the next term error is expensive
- // to calculate and the theoretic bounds have arbitrary constants
- For(k:=1,k<=5+Floor(SqrtN(n)*0.5) And ( term=0 Or Abs(term)>0.1) ,k++)[
- A:=0;
- For(h:=1,h<=k,h++)[
- if( Gcd(h,k)=1 )[
- A:=A+Exp(I*Pi*Sum(j,1,k-1,(j/k)*((h*j)/k - Floor((h*j)/k) -1/2))
-- 2*Pi*I*h*n/k );
- ];
- ];
- If(A!=0, term:= N(A*Sqrt(k)*(Deriv(m) Sinh(C*lambda)/lambda) Where m==n ),term:=0 );
-// Echo("Term ",k,"is ",N(term/(Pi*Sqrt(2))));
- pa:=pa+term;
-// Echo("result", N(pa/(Pi*Sqrt(2))));
- ];
- pa:=N(pa/(Pi*Sqrt(2)));
- BuiltinPrecisionSet(GlobalPop());
- Round(pa);
- ];
-
-/// integer partitions by recurrence relation P(n) = Sum(k,1,n, (-1)^(k+1)*( P(n-k*(3*k-1)/2)+P(n-k*(3*k+1)/2) ) ) = P(n-1)+P(n-2)-P(n-5)-P(n-7)+...
-/// where 1, 2, 5, 7, ... is the "generalized pentagonal sequence"
-/// this method is faster with internal math for number<300 or so.
-PartitionsP'recur(number_IsPositiveInteger) <--
-[
- // need storage of n values PartitionsP(k) for k=1,...,n
- Local(sign, cache, n, k, pentagonal, P);
- cache:=ArrayCreate(number+1,1); // cache[n] = PartitionsP(n-1)
- n := 1;
- While(n ProperDivisors(180)
- Out> 17;
- In> ProperDivisors(37)
- Out> 1;
-
-*SEE DivisorsSum, ProperDivisors, ProperDivisorsSum, Moebius
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/ProperDivisorsSum.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/ProperDivisorsSum.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/ProperDivisorsSum.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/ProperDivisorsSum.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="ProperDivisorsSum"
-
-10 # ProperDivisorsSum(_n) <--
-[
- Check(IsPositiveInteger(n),
- "ProperDivisorsSum: argument must be positive integer");
- DivisorsSum(n)-n;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="ProperDivisorsSum",categories="User Functions;Number Theory"
-*CMD ProperDivisorsSum --- the sum of proper divisors
-*STD
-*CALL
- ProperDivisorsSum(n)
-*PARMS
-
-{n} -- positive integer
-
-*DESC
-
-{ProperDivisorsSum} returns the sum of proper divisors, i.e. {ProperDivisors(n)-n},
-since {n} is not counted.
-{n} is prime if and only if {ProperDivisorsSum(n)==1}.
-
-*E.G.
- In> ProperDivisorsSum(180)
- Out> 366;
- In> ProperDivisorsSum(37)
- Out> 1;
-
-
-*SEE DivisorsSum, ProperDivisors, ProperDivisorsSum, Moebius
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Repunit.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Repunit.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Repunit.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Repunit.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,10 +0,0 @@
-%mathpiper,def="Repunit"
-
-10 # Repunit(0) <-- 0;
-// Number consisting of n 1's
-Repunit(n_IsPositiveInteger) <--
-[
- (10^n-1)/9;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/StirlingNumber1.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/StirlingNumber1.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/StirlingNumber1.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/StirlingNumber1.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,38 +0,0 @@
-%mathpiper,def="StirlingNumber1"
-
-10 # StirlingNumber1(n_IsInteger,0) <-- If(n=0,1,0);
-10 # StirlingNumber1(n_IsInteger,1) <-- (-1)^(n-1)*(n-1)!;
-10 # StirlingNumber1(n_IsInteger,2) <-- (-1)^n*(n-1)! * HarmonicNumber(n-1);
-10 # StirlingNumber1(n_IsInteger,n-1) <-- -BinomialCoefficient(n,2);
-10 # StirlingNumber1(n_IsInteger,3) <-- (-1)^(n-1)*(n-1)! * (HarmonicNumber(n-1)^2 - HarmonicNumber(n-1,2))/2;
-20 # StirlingNumber1(n_IsInteger,m_IsInteger) <--
- Sum(k,0,n-m,(-1)^k*BinomialCoefficient(k+n-1,k+n-m)*BinomialCoefficient(2*n-m,n-k-m)*StirlingNumber2(k-m+n,k));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="StirlingNumber1",categories="User Functions;Number Theory"
-*CMD StirlingNumber1 --- return the {n m}th Stirling Number of the first kind
-*STD
-*CALL
- StirlingNumber1(n,m)
-*PARMS
-
-{n}, {m} -- positive integers
-
-*DESC
-
-This function returns the signed Stirling Number of the first kind.
-All Stirling Numbers are integers. If $ m > n $, then {StirlingNumber1} returns
-$0$.
-
-*E.G.
-
- In> StirlingNumber1(10,5)
- Out> -269325;
- In> StirlingNumber1(3,6)
- Out> 0;
-
-*SEE StirlingNumber2
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/StirlingNumber2.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/StirlingNumber2.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/StirlingNumber2.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/StirlingNumber2.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="StirlingNumber2"
-
-10 # StirlingNumber2(n_IsInteger,0) <-- If(n=0,1,0);
-20 # StirlingNumber2(n_IsInteger,k_IsInteger) <-- Sum(i,0,k-1,(-1)^i*BinomialCoefficient(k,i)*(k-i)^n)/ k! ;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="StirlingNumber2",categories="User Functions;Number Theory"
-*CMD StirlingNumber2 --- return the {n m}th Stirling Number of the second kind
-*STD
-*CALL
- StirlingNumber1(n,m)
-*PARMS
-
-{n}, {m} -- positive integers
-
-*DESC
-
-This function returns the Stirling Number of the second kind.
-All Stirling Numbers are positive integers. If $ m > n $, then {StirlingNumber2} returns
-$0$.
-
-*E.G.
-
- In> StirlingNumber2(3,6)
- Out> 0;
- In> StirlingNumber2(10,4)
- Out> 34105;
-
-*SEE StirlingNumber1
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Totient.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Totient.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/numbers/Totient.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/numbers/Totient.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,21 +0,0 @@
-%mathpiper,def="Totient"
-
-// Algorithm adapted from:
-// Elementary Number Theory, David M. Burton
-// Theorem 7.3 p139
-
-10 # Totient(_n) <--
-[
- Check(IsPositiveInteger(n),
- "Totient: argument must be positive integer");
- Local(i,sum,factors,len);
- sum:=n;
- factors:=Factors(n);
- len:=Length(factors);
- For(i:=1,i<=len,i++)[
- sum:=sum*(1-1/factors[i][1]);
- ];
- sum;
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/odesolver/odesolver.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/odesolver/odesolver.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/odesolver/odesolver.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/odesolver/odesolver.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,382 +0,0 @@
-%mathpiper,def="OdeSolve;OdeTest;OdeOrder"
-
-/* def file definitions
-OdeSolve
-OdeTest
-OdeOrder
-*/
-
-/*
- 1) implement more sub-solvers
- 2) test code
- 3) Done: documentation for OdeSolve and OdeTest
- */
-
-10 # OdeLeftHandSideEq(_l == _r) <-- (l-r);
-20 # OdeLeftHandSideEq(_e) <-- e;
-
-10 # OdeNormChange(y(n_IsInteger)) <-- UnList({yyy,n});
-20 # OdeNormChange(y) <-- yyy(0);
-25 # OdeNormChange(y') <-- yyy(1);
-25 # OdeNormChange(y'') <-- yyy(2);
-30 # OdeNormChange(_e) <-- e;
-OdeNormPred(_e) <-- (e != OdeNormChange(e));
-
-
-OdeNormalForm(_e) <--
-[
- e := Substitute(OdeLeftHandSideEq(e),"OdeNormPred","OdeNormChange");
-];
-
-/*TODO better OdeNormalForm?
-OdeNormalForm(_e) <--
-[
- OdeLeftHandSideEq(e) /:
- {
- y <- yyy(0),
- y' <- yyy(1),
- y'' <- yyy(2),
- y(_n) <- yyy(n)
- };
-];
-*/
-
-10 # OdeChange(yyy(n_IsInteger)) <-- Apply(yn,{n});
-30 # OdeChange(_e) <-- e;
-OdePred(_e) <-- (e != OdeChange(e));
-UnFence("OdeChange",1);
-UnFence("OdePred",1);
-OdeSubstitute(_e,_yn) <--
-[
- Substitute(e,"OdePred","OdeChange");
-];
-UnFence("OdeSubstitute",2);
-
-OdeConstantList(n_IsInteger) <--
-[
- Local(result,i);
- result:=ZeroVector(n);
- For (i:=1,i<=n,i++) result[i]:=UniqueConstant();
- result;
-];
-
-
-RuleBase("OdeTerm",{px,list});
-
-/*5 # OdeFlatTerm(_x)_[Echo({x});False;] <-- True; */
-
-10# OdeFlatTerm(OdeTerm(_a0,_b0)+OdeTerm(_a1,_b1)) <-- OdeTerm(a0+a1,b0+b1);
-10# OdeFlatTerm(OdeTerm(_a0,_b0)-OdeTerm(_a1,_b1)) <-- OdeTerm(a0-a1,b0-b1);
-10# OdeFlatTerm(-OdeTerm(_a1,_b1)) <-- OdeTerm(-a1,-b1);
-10# OdeFlatTerm(OdeTerm(_a0,_b0)*OdeTerm(_a1,_b1))_
- (IsZeroVector(b0) Or IsZeroVector(b1)) <--
-[
- OdeTerm(a0*a1,a1*b0+a0*b1);
-];
-
-10# OdeFlatTerm(OdeTerm(_a0,_b0)/OdeTerm(_a1,_b1))_
- (IsZeroVector(b1)) <--
- OdeTerm(a0/a1,b0/a1);
-
-10# OdeFlatTerm(OdeTerm(_a0,b0_IsZeroVector)^OdeTerm(_a1,b1_IsZeroVector)) <--
- OdeTerm(a0^a1,b0);
-15 # OdeFlatTerm(OdeTerm(_a,_b)) <-- OdeTerm(a,b);
-
-15# OdeFlatTerm(OdeTerm(_a0,_b0)*OdeTerm(_a1,_b1)) <-- OdeTermFail();
-15# OdeFlatTerm(OdeTerm(_a0,b0)^OdeTerm(_a1,b1)) <-- OdeTermFail();
-15# OdeFlatTerm(OdeTerm(_a0,b0)/OdeTerm(_a1,b1)) <-- OdeTermFail();
-20 # OdeFlatTerm(a_IsAtom) <-- OdeTermFail();
-
-20 # OdeFlatTerm(_a+_b) <-- OdeFlatTerm(OdeFlatTerm(a) + OdeFlatTerm(b));
-20 # OdeFlatTerm(_a-_b) <-- OdeFlatTerm(OdeFlatTerm(a) - OdeFlatTerm(b));
-20 # OdeFlatTerm(_a*_b) <-- OdeFlatTerm(OdeFlatTerm(a) * OdeFlatTerm(b));
-20 # OdeFlatTerm(_a^_b) <-- OdeFlatTerm(OdeFlatTerm(a) ^ OdeFlatTerm(b));
-20 # OdeFlatTerm(_a/_b) <-- OdeFlatTerm(OdeFlatTerm(a) / OdeFlatTerm(b));
-
-OdeMakeTerm(xx_IsAtom) <-- OdeTerm(xx,FillList(0,10));
-OdeMakeTerm(yyy(_n)) <-- OdeTerm(0,BaseVector(n+1,10));
-
-
-20 # OdeMakeTerm(_xx) <-- OdeTerm(xx,FillList(0,10));
-10 # OdeMakeTermPred(_x+_y) <-- False;
-10 # OdeMakeTermPred(_x-_y) <-- False;
-10 # OdeMakeTermPred( -_y) <-- False;
-10 # OdeMakeTermPred(_x*_y) <-- False;
-10 # OdeMakeTermPred(_x/_y) <-- False;
-10 # OdeMakeTermPred(_x^_y) <-- False;
-20 # OdeMakeTermPred(_rest) <-- True;
-
-
-OdeCoefList(_e) <--
-[
- Substitute(e,"OdeMakeTermPred","OdeMakeTerm");
-];
-OdeTermFail() <-- OdeTerm(Error,FillList(Error,10));
-
-// should check if it is linear...
-OdeAuxiliaryEquation(_e) <--
-[
- // extra conversion that should be optimized away later
- e:=OdeNormalForm(e);
- e:=OdeSubstitute(e,{{n},aaa^n*Exp(aaa*x)});
- e:=Subst(Exp(aaa*x),1)e;
- Simplify(Subst(aaa,x)e);
-];
-
-/* Solving a Homogeneous linear differential equation
- with real constant coefficients */
-OdeSolveLinearHomogeneousConstantCoefficients(_e) <--
-[
- Local(roots,consts,auxeqn);
-
- /* Try solution Exp(aaa*x), and divide by Exp(aaa*x), which
- * should yield a polynomial in aaa.
- e:=OdeSubstitute(e,{{n},aaa^n*Exp(aaa*x)});
- e:=Subst(Exp(aaa*x),1)e;
- auxeqn:=Simplify(Subst(aaa,x)e);
- e:=auxeqn;
- */
- e:=OdeAuxiliaryEquation(e);
- auxeqn:=e;
-
- If(InVerboseMode(), Echo("OdeSolve: Auxiliary Eqn ",auxeqn) );
-
-
- /* Solve the resulting polynomial */
- e := Apply("RootsWithMultiples",{e});
- e := RemoveDuplicates(e);
-
- /* Generate dummy constants */
- if( Length(e) > 0 )[
- roots:=Transpose(e);
- consts:= MapSingle(Hold({{nn},Add(OdeConstantList(nn)*(x^(0 .. (nn-1))))}),roots[2]);
- roots:=roots[1];
-
- /* Return results */
- //Sum(consts * Exp(roots*x));
- Add( consts * Exp(roots*x) );
- ] else if ( Degree(auxeqn,x) = 2 ) [
- // we can solve second order equations without RootsWithMultiples
- Local(a,b,c,roots);
- roots:=ZeroVector(2);
-
- // this should probably be incorporated into RootsWithMultiples
- {c,b,a} := Coef(auxeqn,x,0 .. 2);
-
-
- roots := PSolve(a*x^2+b*x+c,x);
- If(InVerboseMode(),Echo("OdeSolve: Roots of quadratic:",roots) );
-
- // assuming real coefficients, the roots must come in a complex
- // conjugate pair, so we don't have to check both
- // also, we don't need to check to repeated root case, because
- // RootsWithMultiples (hopefully) catches those, except for
- // the case b,c=0
-
- if( b=0 And c=0 )[
- Add(OdeConstantList(2)*{1,x});
- ] else if( IsNumber(N(roots[1])) )[
- If(InVerboseMode(),Echo("OdeSolve: Real roots"));
- Add(OdeConstantList(2)*{Exp(roots[1]*x),Exp(roots[2]*x)});
- ] else [
- If(InVerboseMode(),Echo("OdeSolve: Complex conjugate pair roots"));
- Local(alpha,beta);
- alpha:=Re(roots[1]);
- beta:=Im(roots[1]);
- Exp(alpha*x)*Add( OdeConstantList(2)*{Sin(beta*x),Cos(beta*x)} );
- ];
-
- ] else [
- Echo("OdeSolve: Could not find roots of auxilliary equation");
- ];
-];
-
-// this croaks on Sin(x)*y'' because OdeMakeTerm does
-10 # OdeOrder(_e) <-- [
- Local(h,i,coefs);
-
- coefs:=ZeroVector(10); //ugly
- e:=OdeNormalForm(e);
-
- If(InVerboseMode(),Echo("OdeSolve: Normal form is",e));
- h:=OdeFlatTerm(OdeCoefList(e));
- If(InVerboseMode(),Echo("OdeSolve: Flatterm is",h));
-
- // get the list of coefficients of the derivatives
- // in decreasing order
- coefs:=Reverse(Listify(h)[3]);
- While( First(coefs) = 0 )[
- coefs:=Rest(coefs);
- ];
- Length(coefs)-1;
-];
-
-
-10 # OdeSolve(_expr)_(OdeOrder(expr)=0) <-- Echo("OdeSolve: Not a differential equation");
-
-// Solve the ever lovable seperable equation
-
-10 # OdeSolve(y'+_a==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==expr-a);
-10 # OdeSolve(y'-_a==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==expr+a);
-10 # OdeSolve(y'/_a==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==expr*a);
-10 # OdeSolve(_a*y'==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==expr/a);
-10 # OdeSolve(y'*_a==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==expr/a);
-10 # OdeSolve(_a/y'==_expr)_(IsFreeOf(y,a)) <-- OdeSolve(y'==a/expr);
-
-// only works for low order equations
-10 # OdeSolve(y'==_expr)_(IsFreeOf({y,y',y''},expr)) <--
-[
- If(InVerboseMode(),Echo("OdeSolve: Integral in disguise!"));
- If(InVerboseMode(),Echo("OdeSolve: Attempting to integrate ",expr));
-
- (Integrate(x) expr)+UniqueConstant();
-];
-
-50 # OdeSolve(_e) <--
-[
- Local(h);
- e:=OdeNormalForm(e);
- If(InVerboseMode(),Echo("OdeSolve: Normal form is",e));
- h:=OdeFlatTerm(OdeCoefList(e));
- If(InVerboseMode(),Echo("OdeSolve: Flatterm is",h));
- if (IsFreeOf(Error,h))
- [
- OdeSolveLinear(e,h);
- ]
- else
- OdeUnsolved(e);
-];
-
-10 # OdeSolveLinear(_e,OdeTerm(0,_list))_(Length(VarList(list)) = 0) <--
-[
- OdeSolveLinearHomogeneousConstantCoefficients(OdeNormalForm(e));
-];
-
-100 # OdeSolveLinear(_e,_ode) <-- OdeUnsolved(e);
-
-OdeUnsolved(_e) <-- Subst(yyy,y)e;
-
-
-
-/*
-FT3(_e) <--
-[
- e:=OdeNormalForm(e);
-Echo({e});
- e:=OdeCoefList(e);
-Echo({e});
- e:=OdeFlatTerm(e);
-Echo({e});
- e;
-];
-OdeBoundaries(_solution,bounds_IsList) <--
-[
-];
-*/
-
-OdeTest(_e,_solution) <--
-[
- Local(s);
- s:= `Lambda({n},if (n>0)(D(x,n)(@solution)) else (@solution));
- e:=OdeNormalForm(e);
- e:=Apply("OdeSubstitute",{e,s});
- e:=Simplify(e);
- e;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="OdeSolve",categories="User Functions;Differential Equations"
-*CMD OdeSolve --- general ODE solver
-*STD
-*CALL
- OdeSolve(expr1==expr2)
-*PARMS
-
-{expr1,expr2} -- expressions containing a function to solve for
-
-*DESC
-
-This function currently can solve second order homogeneous linear real constant
-coefficient equations. The solution is returned with unique constants
-generated by {UniqueConstant}. The roots of the auxiliary equation are
-used as the arguments of exponentials. If the roots are complex conjugate
-pairs, then the solution returned is in the form of exponentials, sines
-and cosines.
-
-First and second derivatives are entered as {y',y''}. Higher order derivatives
-may be entered as {y(n)}, where {n} is any integer.
-
-
-*E.G.
-
- In> OdeSolve( y'' + y == 0 )
- Out> C42*Sin(x)+C43*Cos(x);
- In> OdeSolve( 2*y'' + 3*y' + 5*y == 0 )
- Out> Exp(((-3)*x)/4)*(C78*Sin(Sqrt(31/16)*x)+C79*Cos(Sqrt(31/16)*x));
- In> OdeSolve( y'' - 4*y == 0 )
- Out> C132*Exp((-2)*x)+C136*Exp(2*x);
- In> OdeSolve( y'' +2*y' + y == 0 )
- Out> (C183+C184*x)*Exp(-x);
-
-*SEE Solve, RootsWithMultiples
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OdeTest",categories="User Functions;Differential Equations"
-*CMD OdeTest --- test the solution of an ODE
-*STD
-*CALL
- OdeTest(eqn,testsol)
-*PARMS
-
-{eqn} -- equation to test
-
-{testsol} -- test solution
-
-*DESC
-
-This function automates the verification of the solution of an ODE.
-It can also be used to quickly see how a particular equation operates
-on a function.
-
-*E.G.
-
- In> OdeTest(y''+y,Sin(x)+Cos(x))
- Out> 0;
- In> OdeTest(y''+2*y,Sin(x)+Cos(x))
- Out> Sin(x)+Cos(x);
-
-*SEE OdeSolve
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OdeOrder",categories="User Functions;Differential Equations"
-*CMD OdeOrder --- return order of an ODE
-*STD
-*CALL
- OdeOrder(eqn)
-*PARMS
-
-{eqn} -- equation
-
-*DESC
-
-This function returns the order of the differential equation, which is
-order of the highest derivative. If no derivatives appear, zero is returned.
-
-*E.G.
-
- In> OdeOrder(y'' + 2*y' == 0)
- Out> 2;
- In> OdeOrder(Sin(x)*y(5) + 2*y' == 0)
- Out> 5;
- In> OdeOrder(2*y + Sin(y) == 0)
- Out> 0;
-
-*SEE OdeSolve
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/openmath/openmath.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/openmath/openmath.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/openmath/openmath.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/openmath/openmath.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,937 +0,0 @@
-%mathpiper,def="OMREP;OMDef;OMForm;OMRead;OMParse;OMEcho;OMEchoEscape"
-
-/* def file definitions
-OMREP
-OMDef
-OMForm
-OMRead
-OMParse
-OMEcho
-OMEchoEscape
-*/
-
-////////////////////////
-// Written by Alberto González Palomo and Ayal Pinkus.
-////////////////////////
-
-/* The read-eval-print loop */
-/* It can take one parameter, that is the evaluation count. If it is greater
- than zero, only that number of iterations will be performed before
- exiting. This is particularly useful when connecting to MathPiper via pipes.
-*/
-RuleBase("OMREP",{});
-Rule("OMREP",0,1,True)
-[
- OMREP(0);// 0 means keep repeating, as usual.
-];
-RuleBase("OMREP",{count});
-LocalSymbols(input,stringOut,result)
-Rule("OMREP",1,1,True)
-[
- Local(input,stringOut,result);
- While(Not(IsExitRequested()))
- [
- Set(errorObject, "");
- TrapError(Set(input, FromString(ConcatStrings(ReadCmdLineString("")," "))OMRead()),Set(errorObject,OMGetCoreError()));
- If(Not(errorObject = ""), errorObject);
- If (Not(IsExitRequested()) And errorObject="",
- [
- Set(stringOut,"");
- Set(result,False);
- TrapError(Set(stringOut,ToString()[Secure(Set(result,Eval(input)));]),Set(errorObject,OMGetCoreError()));
- If(Not(errorObject = ""), errorObject);
- If(Not(stringOut = ""), WriteString(stringOut));
- SetGlobalLazyVariable(%,result);
- If(PrettyPrinter'Get()="",
- [
- Apply("OMForm",{result});
- ],
- Apply(PrettyPrinter'Get(),{result}));
- If(count > 0 And (count:=count-1) = 0, Exit());
- ]);
- ];
-];
-
-
-LocalSymbols(omindent) [
- // Function definitions
- OMIndent() := [omindent := omindent + 2;];
- OMUndent() := [omindent := omindent - 2;];
- OMClearIndent() := [omindent := 0;];
- OMIndentSpace() := Space(omindent);
-
- // Initialization of indentation
- OMClearIndent();
-]; // LocalSymbols(omindent)
-
-///////////////////////////////////////////////////////////////////////
-// Output
-
-10 # OMForm(_expression)
- <--
- [
- OMClearIndent();
- OMEcho("");
- OMIndent();
- If(IsAtom(expression),
- If(expression = Atom("%"),
- Secure(expression := Eval(expression))
- )
- );
- OMFormExpression(expression);
- OMUndent();
- OMEcho("");
- ];
-
-10 # OMFormExpression(i_IsString) <-- OMEcho("":i:"");
-11 # OMFormExpression(i_IsInteger) <-- OMEcho("":String(i):"");
-12 # OMFormExpression(i_IsNumber) <-- OMEcho("");
-13 # OMFormExpression(i_IsConstant)_(OMSymbol()[ String(i) ] != Empty)
- <-- OMEcho(""
- );
-14 # OMFormExpression(i_IsConstant)// Should we rather evaluate it?
- <-- OMEcho("");
-15 # OMFormExpression(i_IsVariable)_(OMSymbol()[ String(i) ] != Empty)
- <-- OMEcho(""
- );
-16 # OMFormExpression(i_IsVariable)
- <-- OMEcho("");
-16 # OMFormExpression(i_IsVariable)_(i = Empty)
- <-- False; // This is useful for void expressions.
-
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMError")
- <--
- [
- Local(cd, name);
- If(IsList(function[1]),
- [ cd := function[1][1]; name := function[1][2]; ],
- [ cd := "error"; name := function[1]; ]);
- OMEcho("");
- OMIndent();
- OMEcho("");
- ForEach(i, Rest(function)) OMFormExpression(i);
- OMUndent();
- OMEcho("");
- ];
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OME")
- <--
- [
- OMEcho("");
- OMIndent();
- ForEach(i, function) OMFormExpression(i);
- OMUndent();
- OMEcho("");
- ];
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMS")
- <-- OMEcho("");
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMBIND")
- <--
- [
- OMEcho("");
- OMIndent();
- ForEach(i, function) OMFormExpression(i);
- OMUndent();
- OMEcho("");
- ];
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMBVAR")
- <--
- [
- OMEcho("");
- OMIndent();
- ForEach(i, function) OMFormExpression(i);
- OMUndent();
- OMEcho("");
- ];
-10 # OMFormExpression(function_IsFunction)_(Type(function) = "OMA")
- <--
- [
- // This is not the same as the next rule: this is OMA(a,b,c,...),
- // which is used for building OMA constructs in the mapping to OM.
- OMEcho("");
- OMIndent();
- ForEach(i, function) OMFormExpression(i);
- OMUndent();
- OMEcho("");
- ];
-11 # OMFormExpression(function_IsFunction)
- <--
- [
- OMEcho("");
- OMIndent();
- OMFormFunction(function);
- OMUndent();
- OMEcho("");
- ];
-
-11 # OMFormFunction(function_IsFunction)
- <--
- [
- Local(arity);
- arity := Length(function);
- OMEcho("");
- If(arity > 0, ForEach(arg, function) OMFormExpression(arg));
- ];
-10 # OMFormFunction(function_IsFunction)_(OMSymbol()[ Type(function) ] != Empty)
- <--
- [
- Local(symbolDef);
- // [20051016 AGP] The "signature" feature is an old attempt at pattern
- // matching, but now that we have real predicates in the mappings it's
- // probably obsolete. I'll think about removing it.
- symbolDef := OMSymbol()[ OMSignature(function) ];
- If(symbolDef = Empty, symbolDef := OMSymbol()[ Type(function) ] );
- If(symbolDef = Empty Or Length(symbolDef) < 3 Or symbolDef[3] = {},
- [
- OMEcho("");
- ForEach(arg, function) OMFormExpression(arg);
- ],
- [
- Local(result);
- result := OMApplyMapping(function, symbolDef[3]);
- //Check(IsList(result), ToString()Echo("Mapping result is not a list: ", result));
- If(IsList(result),
- [
- result := UnList(Subst($, function[0]) result);
- OMFormExpression(result[0]);
- ForEach(i, result) OMFormExpression(i);
- ],
- If(result = Empty,
- Echo("No rule matched ", function, symbolDef[3]),
- Echo("Unexpected result value from OMApplyMapping(): ", result)
- )
- );
- ]
- );
- ];
-
-
-OMWrite(_expression) <--
-[
- Write(expression);
-];
-
-OMEcho(_expression) <--
-[
- OMIndentSpace();
- Write(expression);
- NewLine();
-];
-OMEcho(expression_IsString) <--
-[
- OMIndentSpace();
- WriteString(expression);
- NewLine();
-];
-OMEcho(expression_IsList) <--
-[
- ForEach(arg, expression)
- [
- If (IsString(arg), WriteString(arg), Write(arg));
- ];
- NewLine();
-];
-
-OMEscape(_expression) <--
-[
- "";
-];
-OMEscapeString(_expression_IsString) <--
-[
- "";
-];
-OMWriteEscape(_expression) <--
-[
- WriteString(OMEscape(expression));
-];
-OMWriteStringEscape(expression_IsString) <--
-[
- WriteString(OMEscapeString(expression));
-];
-OMEchoEscape(_expression) <--
-[
- OMWriteEscape(expression);
- NewLine();
-];
-OMEchoEscape(expression_IsString) <--
-[
- OMWriteStringEscape(expression);
- NewLine();
-];
-OMEchoEscape(expression_IsList) <--
-[
- WriteString("");
- NewLine();
-];
-
-
-HoldArgNr("OMForm",1,1);
-//HoldArgNr("OMFormExpression",1,1);
-//HoldArgNr("OMFormFunction",1,1);
-
-
-OMSignature(_function) <-- "";
-OMSignature(function_IsFunction) <--
-[
- Local(makeSig);
- makeSig := {ConcatStrings, Type(function), "_"};
- Local(type);
- type := "";// If "function" doesn't have parameters, the signature is "f_".
- ForEach(arg, function)
- [
- If(Type(arg) = "List",
- type := "L",
- If(IsFunction(arg),
- type := "F",
- If(IsInteger(arg),
- type := "I",
- type := "V"
- )
- )
- );
- DestructiveAppend(makeSig, type);
- ];
- Secure(Eval(UnList(makeSig)));
-];
-HoldArgNr("OMSignature", 1, 1);
-
-
-
-///////////////////////////////////////////////////////////////////////
-// Input
-
-// Troubleshooting guide:
-// "encodingError:unexpected closing brace": this happens in the ReadOMOBJ
-// rules. It means that you forgot to call OMNextToken() from your rule.
-
-LocalSymbols(omtoken) [
- OMNextToken() :=
- [
- omtoken := XmlExplodeTag(String(ReadToken()));
- ];
- OMToken() := omtoken;
-]; // LocalSymbols(omtoken)
-
-OMRead():=
-[
- Local(result);
- TrapError(
- [
- XmlTokenizer();
- OMNextToken();
- result := MatchOMOBJ(OMToken());
- DefaultTokenizer();
- ],
- [
- result := OMGetCoreError();
- DefaultTokenizer();
- ]);
- result;
-];
-
-
-OMDump(str):=
-FromString(str:" EndOfFile")
-[
- Local(result);
- XmlTokenizer();
- OMNextToken();
- While(OMToken() != "EndOfFile")
- [
- Echo("Exploded ",OMToken());
- OMNextToken();
- ];
- DefaultTokenizer();
- True;
-];
-
-
-
-10 # MatchClose(_x)_(x = OMToken()) <-- [OMNextToken();True;];
-20 # MatchClose(_x) <-- Check(False,ToString()Echo("encodingError:unexpected closing brace")); //@@@ TODO better error reporting
-
-10 # MatchOMOBJ(XmlTag("OMOBJ",_attributes,"Open")) <--
-[
- // Any attributes are ignored.
- Local(result);
- OMNextToken();
- result := ReadOMOBJ(OMToken());
- MatchClose(XmlTag("OMOBJ",{},"Close"));
- result;
-];
-10 # MatchOMOBJ(XmlTag("OMOBJ",_attributes,"OpenClose")) <--
-[
- OMNextToken();
- // Any attributes are ignored.
- // This is a void expression, of the form "".
- Empty;
-];
-20 # MatchOMOBJ(_rest) <-- Check(False,ToString()Echo("encodingError:not an OMOBJ :",rest));
-
-10 # ReadOMOBJ(XmlTag("OMOBJ",_attributes,"Close")) <--
-[
- // This is a void expression, of the form "".
- Empty;
-];
-
-10 # ReadOMOBJ(XmlTag("OMI",{},"Open")) <--
-[
- Local(result);
- OMNextToken();
- result := Atom(OMToken());
- OMNextToken();
- MatchClose(XmlTag("OMI",{},"Close"));
- result;
-];
-
-10 # ReadOMOBJ(XmlTag("OMV",{{"NAME",_name}},"OpenClose")) <--
-[
- OMNextToken();
- Atom(name);
-];
-
-10 # ReadOMOBJ(XmlTag("OMF",{{"DEC",_dec}},"OpenClose")) <--
-[
- OMNextToken();
- Atom(dec);
-];
-
-10 # ReadOMOBJ(XmlTag("OMSTR",{},"Open")) <--
-[
- Local(result);
- OMNextToken();
- If(IsString(OMToken()), [result := OMToken(); OMNextToken();], result := "");
- MatchClose(XmlTag("OMSTR",{},"Close"));
- result;
-];
-10 # ReadOMOBJ(XmlTag("OMSTR",{},"OpenClose")) <--
-[
- OMNextToken();
- "";
-];
-
-10 # ReadOMOBJ(XmlTag("OMA",{},"Open")) <--
-[
- Local(result, new);
- result:={};
- OMNextToken();
- While (OMToken() != XmlTag("OMA",{},"Close"))
- [
- new:=ReadOMOBJ(OMToken());
- DestructiveAppend(result,new);
- ];
- MatchClose(XmlTag("OMA",{},"Close"));
- OMApplyReverseMapping(UnList(result));
-];
-
-10 # ReadOMOBJ(XmlTag("OMBIND",{},"Open")) <--
-[
- Local(result, new);
- result:={};
- OMNextToken();
- While (OMToken() != XmlTag("OMBIND",{},"Close"))
- [
- new:=ReadOMOBJ(OMToken());
- DestructiveAppend(result,new);
- ];
- MatchClose(XmlTag("OMBIND",{},"Close"));
- result;
-];
-10 # ReadOMOBJ(XmlTag("OMBVAR",{},"Open")) <--
-[
- Local(result, new);
- result:={};
- OMNextToken();
- While (OMToken() != XmlTag("OMBVAR",{},"Close"))
- [
- new:=ReadOMOBJ(OMToken());
- DestructiveAppend(result,new);
- ];
- MatchClose(XmlTag("OMBVAR",{},"Close"));
- result;
-];
-
-10 # OMApplyReverseMapping(piperExp_IsFunction) <-- piperExp;
-10 # OMApplyReverseMapping(piperExp_IsFunction)_(OMSymbol()[ Type(piperExp) ] != Empty)
- <--
- [
- Local(symbolDef, result);
- symbolDef := OMSymbol()[ Type(piperExp) ];
- If(symbolDef[4] = {},
- result := piperExp,
- [
- result := OMApplyMapping(piperExp, symbolDef[4]);
- result := Subst($, piperExp[0]) result;
- If(IsList(result), result := UnList(result));
- ]
- );
- result;
- ];
-
-10 # OMApplyMapping(_function, _mapping) <--
-[
- Local(expandRules, result);
- expandRules := { _(_path) <- OMPathSelect(path, function) };
- expandRules[1][2][2] := function;// the "function" variable is not expanded above.
-
- mapping := (mapping /: expandRules);// "/:" has lower precedence than ":=".
-
- Local(ruleMatched);
- ruleMatched := False;
- If(Type(mapping) = "|",
- [
- mapping := Flatten(mapping, "|");
- ForEach(rule, mapping)
- If(Not ruleMatched,
- [
- If(Type(rule) = "_",
- If( Eval(rule[2]), [ result := rule[1]; ruleMatched := True; ] ),
- [ result := rule; ruleMatched := True; ]
- );
- ]
- );
- ],
- [
- If(Type(mapping) = "_",
- If(Eval(mapping[2]),
- result := mapping[1],
- result := Listify(function)
- ),
- result := mapping
- );
- ruleMatched := True;
- ]
- );
-
- If(ruleMatched,
- If(Type(result) = ":",
- If(Length(result) = 2,
- result[1]:result[2],
- result),// Perhaps we should give a warning here.
- result),
- Empty);
-];
-
-11 # OMPathSelect(path_IsNumber, _expression) <--
-[
- If(path >= 0 And path <= Length(expression),
- expression[path],
- Undefined);
-];
-11 # OMPathSelect(path_IsList, _expression) <--
-[
- ForEach(i, path)
- If(IsFunction(expression) And i >= 0 And i <= Length(expression),
- expression := expression[i],
- Undefined);
- expression;
-];
-HoldArgNr("OMPathSelect", 2, 2);
-
-// Previously, any unknown symbols where reported as errors.
-// Now, we just store them as OMS(cd, name) since MathPiper is perfectly happy
-// with such unknown symbols, and will handle them right: When
-// producing an OpenMath result from them, they will be output back
-// unmodified, forming a valid OpenMath expression.
-// This way we don't have to bother defining bogus symbols for concepts that
-// MathPiper does not handle.
-100 # ReadOMOBJ(XmlTag("OMS", _attributes, "OpenClose")) <--
-[
- OMNextToken();
- Local(omcd, omname);
- omcd := attributes["CD"];
- omname := attributes["NAME"];
- If(omcd = Empty Or omname = Empty,
- OMCheck(False,OMError({"moreerrors", "encodingError"}, ToString()Echo("missing \"cd\" or \"name\" attribute: ",attributes))),
- [
- Local(cdTable, piperform);
- cdTable := OMSymbolReverse()[ omcd ];
- If(cdTable != Empty, piperform := cdTable[ omname ]);
- // We can not optimize here by checking first whether the CD is mathpiper
- // and avoiding the table lookup then, because for some symbols the
- // OM name have to be different from the MathPiper name (e.g. "/@").
- If(piperform = Empty,
- If(cd = mathpiper, Atom(omname), OMS(omcd, omname)),
- If(IsString(piperform), Atom(piperform), piperform));
- ]
- );
-];
-
-101 # ReadOMOBJ(_rest) <-- OMCheck(False,OMError({"moreerrors", "encodingError"}, ToString()Echo("unhandled tag: ",rest)));
-
-
-
-///////////////////////////////////////////////////////////////////////
-// Error reporting
-
-Macro(OMCheck,{predicate,error})
-[
- If(Not(@predicate),
- [
- Assert("omErrorObject", @error) False;
- Check(False,"omErrorObject");
- ]
- ,
- True);
-];
-OMGetCoreError():=
-[
- Local(result);
- result := GetCoreError();
- If(result != "",
- If( IsError("omErrorObject"),
- [result := GetError("omErrorObject"); ],
- [result := OMError({"moreerrors", "unexpected"}, result); ])
- );
- result;
-];
-
-
-
-///////////////////////////////////////////////////////////////////////
-// Symbol mapping tables
-
-LocalSymbols(omsymbol, omsymbolreverse) [
- // Initialization of the openmath symbol dictionaries
- omsymbol := {};
- omsymbolreverse := {};
-
- // Access to the dictionaries
- OMSymbol() := omsymbol;
- OMSymbolReverse() := omsymbolreverse;
-
-]; // LocalSymbols(omsymbol, omsymbolreverse)
-
-OMDef(_piperform, omcd_IsString, omname_IsString, _directMapping, _reverseMapping) <--
-[
- Local(cdTable);
- If(IsString(piperform),
- OMSymbol()[ piperform ] := {omcd, omname, directMapping, reverseMapping}
- );
- cdTable := OMSymbolReverse()[ omcd ];
- If(cdTable = Empty,
- OMSymbolReverse()[ omcd ] := {{omname, piperform}},
- [
- Local(oldMathPiperform);
- oldMathPiperform := cdTable[ omname ];
- If(oldMathPiperform = Empty,
- cdTable[ omname ] := piperform,
- [
- If(oldMathPiperform != piperform,
- [
- cdTable[ omname ] := piperform;
- Echo("Warning: the mapping for ", omcd, ":", omname,
- " was already defined as ", oldMathPiperform,
- ", but is redefined now as ", piperform
- );
- ]
- );
- ]
- );
- ]
- );
- True;
-];
-
-OMDef(_piperform, omcd_IsString, omname_IsString)
-<-- OMDef(piperform, omcd, omname, {}, {});
-
-OMDef(piperalias_IsString, pipername_IsString) <--
-[
- OMSymbol()[ piperalias ] := OMSymbol()[ pipername ];
-];
-HoldArgNr("OMDef", 5, 4);
-HoldArgNr("OMDef", 5, 5);
-
-// Many objects, such as matrices and sets, do not have a specific
-// encoding in MathPiper, but are represented as lists.
-OMDef( {}, "set1","emptyset" );
-OMDef( "List", "set1","set" );
-OMDef( "List", "linalg2","matrix" );
-OMDef( "List", "linalg2","matrixrow" );
-OMDef( "List", "linalg2","vector" );
-OMDef( "List", "list1","list" );
-
-// [20010916 AGP] I couldn't find these symbols in the def files:
-// "E" , "nums1", "e"
-// "Gamma" , "nums1", "gamma"
-OMDef( "Infinity" , "nums1", "infinity" );
-OMDef( "Undefined", "nums1", "NaN" );
-// [20010916 AGP] From org/mathpiper/assembledscripts/initialization.rep/stdopers.mpi:
-OMDef( "And" , "logic1", "and" );
-OMDef( "==" , "logic1", "equivalent" );
-OMDef( "!==" , "logic1", "not",
- { "",
- 1,
- 2,
- ""
- }
- );
-OMDef( "False", "logic1", "false" );
-OMDef( "Or" , "logic1", "or" );
-OMDef( "True" , "logic1", "true" );
-//[20010916 AGP ] Xor is not available in MathPiper.
-// "Xor" , "logic1", "xor" );
-OMDef( "&" , mathpiper, "bitwise_and" );
-OMDef( "|" , mathpiper, "bitwise_or" );
-OMDef( "%" , mathpiper, "bitwise_xor" );
-OMDef( "/" , "arith1", "divide");// This definition is for OM arith1:divide to MathPiper. In all other cases, the next one will be used.
-OMDef( "/" , "nums1", "rational", {$, _1, _2}_(IsRational(_1/_2)) | {OMS("arith1", "divide"), _1, _2}, {/, _1, _2});
-OMDef( "-" , "arith1", "unary_minus");
-OMDef( "-" , "arith1", "minus" );// We need a way of testing the arity.
-OMDef( "+" , "arith1", "plus" );
-OMDef( "^" , "arith1", "power" );
-OMDef( "*" , "arith1", "times" );
-
-
-Use("org/mathpiper/assembledscripts/constants.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/stdfuncs.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/stubs.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/logic.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/complex.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/integrate.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/sums.rep/om.mpi");
-Use("org/mathpiper/assembledscripts/limit.rep/om.mpi");
-//Use("org/mathpiper/assembledscripts/numbers.rep/om.mpi");// Sqrt is loaded before (stubs.rep) than IntNthRoot.
-Use("org/mathpiper/assembledscripts/functional.rep/om.mpi");
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="OMForm;OMRead",categories="User Functions;Input/Output"
-*CMD OMForm --- convert MathPiper expression to OpenMath
-*CMD OMRead --- convert expression from OpenMath to MathPiper expression
-*STD
-*CALL
- OMForm(expression)
- OMRead()
-
-*PARMS
-
-{expression} -- expression to convert
-
-*DESC
-
-{OMForm} prints an OpenMath representation of the input parameter {expression}
-to standard output. {OMRead} reads an OpenMath expression from standard
-input and returns a normal MathPiper expression that matches the input OpenMath
-expression.
-
-If a MathPiper symbol does not have a mapping defined by {OMDef}, it is translated
-to and from OpenMath as the OpenMath symbol in the CD "mathpiper" with the same
-name as it has in MathPiper.
-
-*E.G. notest
-
- In> str:=ToString()OMForm(2+Sin(a*3))
- Out> "
-
-
- 2
-
-
-
-
-
- 3
-
-
-
-
- ";
- In> FromString(str)OMRead()
- Out> 2+Sin(a*3);
-
- In> OMForm(NotDefinedInOpenMath(2+3))
-
-
-
-
-
- 2
- 3
-
-
-
- Out> True
-
-*SEE XmlTokenizer, XmlExplodeTag, OMDef
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OMDef",categories="User Functions;Input/Output"
-*CMD OMDef --- define translations from MathPiper to OpenMath and vice-versa.
-*STD
-*CALL
- OMDef(mathpiperForm, cd, name)
- OMDef(mathpiperForm, cd, name, mathpiperToOM)
- OMDef(mathpiperForm, cd, name, mathpiperToOM, omToMathPiper)
-
-*PARMS
-
-{mathpiperForm} -- string with the name of a MathPiper symbol, or a MathPiper expression
-
-{cd} -- OpenMath Content Dictionary for the symbol
-
-{name} -- OpenMath name for the symbol
-
-{mathpiperToOM} -- rule for translating an application of that symbol in MathPiper into an OpenMath expression
-
-{omToMathPiper} -- rule for translating an OpenMath expression into an application of this symbol in MathPiper
-
-*DESC
-
-{OMDef} defines the translation rules for symbols between the MathPiper
-representation and {OpenMath}.
-The first parameter, {mathpiperForm}, can be a string or an expression. The
-difference is that when giving an expression only the {omToMathPiper} translation
-is defined, and it uses the exact expression given. This is used for {OpenMath}
-symbols that must be translated into a whole subexpression in MathPiper, such
-as {set1:emptyset} which gets translated to an empty list as follows:
- In> OMDef( {}, "set1","emptyset" )
- Out> True
- In> FromString(" ")OMRead()
- Out> {}
- In> IsList(%)
- Out> True
-Otherwise, a symbol that is not inside an application (OMA) gets translated to
-the MathPiper atom with the given name:
- In> OMDef( "EmptySet", "set1","emptyset" )
- Warning: the mapping for set1:emptyset was already defined as {} , but is redefined now as EmptySet
- Out> True
- In> FromString(" ")OMRead()
- Out> EmptySet
-
-The definitions for the symbols in the MathPiper
-library are in the {*.rep} script subdirectories. In those modules for which
-the mappings are defined, there is a file called {om.ys} that contains the
-{OMDef} calls. Those files are loaded in {openmath.rep/om.ys}, so any new
-file must be added to the list there, at the end of the file.
-
-A rule is represented as a list of expressions. Since both OM and
-MathPiper expressions are actually lists, the syntax is the same in both
-directions. There are two template forms that are expanded before the
-translation:
-
-* {$}: this symbol stands for the translation of the symbol applied
-in the original expression.
-
-* {_path}: a path into the original expression (list) to extract an
-element, written as an underscore applied to an integer or a list of integers.
- Those integers are indexes into expressions, and integers in a list are
- applied recursively starting at the original expression.
- For example, {_2} means the second parameter of the expression, while
- {_{3,2,1}} means the first parameter of the second parameter of the third
- parameter of the original expression.
-
-They can appear anywhere in the rule as expressions or subexpressions.
-
-Finally, several alternative rules can be specified by joining them with
-the {|} symbol, and each of them can be annotated with a post-predicate
-applied with the underscore {_} symbol, in the style of MathPiper' simplification
-rules. Only the first alternative rule that matches is applied, so the more
-specific rules must be written first.
-
-There are special symbols recognized by {OMForm} to output {OpenMath}
-constructs that have no specific parallel in MathPiper, such as an OpenMath
-symbol having a {CD} and {name}: MathPiper symbols have only a name.
-Those special symbols are:
-
-* {OMS(cd, name)}: {}
-* {OMA(f x y ...)}: {f x y ...}
-* {OMBIND(binderSymbol, bvars, expression)}: {binderSymbol bvars expression}, where {bvars} must be produced by using {OMBVAR(...)}.
-* {OMBVAR(x y ...)}: {x y ...}
-* {OME(...)}: {...}
-
-When translating from OpenMath to MathPiper, we just store unknown symbols as
-{OMS("cd", "name")}. This way we don't have to bother defining bogus symbols
-for concepts that MathPiper does not handle, and we can evaluate expressions that
-contain them.
-
-*E.G. notest
-
- In> OMDef( "Sqrt" , "arith1", "root", { $, _1, 2 }, $(_1)_(_2=2) | (_1^(1/_2)) );
- Out> True
- In> OMForm(Sqrt(3))
-
-
-
- 3
- 2
-
-
- Out> True
- In> FromString("162 ")OMRead()
- Out> Sqrt(16)
- In> FromString("163 ")OMRead()
- Out> 16^(1/3)
-
- In> OMDef("Limit", "limit1", "limit", \
- { $, _2, OMS("limit1", "under"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Left) \
- |{ $, _2, OMS("limit1", "above"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _4) }_(_3=Right) \
- |{ $, _2, OMS("limit1", "both_sides"), OMBIND(OMS("fns1", "lambda"), OMBVAR(_1), _3) }, \
- { $, _{3,2,1}, _1, Left, _{3,3}}_(_2=OMS("limit1", "below")) \
- |{$, _{3,2,1}, _1, Right, _{3,3}}_(_2=OMS("limit1", "above")) \
- |{$, _{3,2,1}, _1, _{3,3}} \
- );
- In> OMForm(Limit(x,0) Sin(x)/x)
-
-
-
- 0
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- Out> True
- In> OMForm(Limit(x,0,Right) 1/x)
-
-
-
- 0
-
-
-
-
-
-
-
-
- 1
-
-
-
-
-
- Out> True
- In> FromString(ToString()OMForm(Limit(x,0,Right) 1/x))OMRead()
- Out> Limit(x,0,Right)1/x
- In> %
- Out> Infinity
-
-*SEE OMForm, OMRead
-%/mathpiper_docs
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/orthopoly/orthopoly.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/orthopoly/orthopoly.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/orthopoly/orthopoly.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/orthopoly/orthopoly.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,941 +0,0 @@
-%mathpiper,def="OrthoP;OrthoG;OrthoH;OrthoL;OrthoT;OrthoU;OrthoPSum;OrthoGSum;OrthoHSum;OrthoLSum;OrthoTSum;OrthoUSum;EvaluateHornerScheme"
-
-/* def file definitions
-OrthoP
-OrthoG
-OrthoH
-OrthoL
-OrthoT
-OrthoU
-OrthoPSum
-OrthoGSum
-OrthoHSum
-OrthoLSum
-OrthoTSum
-OrthoUSum
-EvaluateHornerScheme
-*/
-
-/*
-Orthogonal polynomials
-version 1.2
-(Serge Winitzki)
-
-Polynomials are found from direct recurrence relations. Sums of series of polynomials are found using the Clenshaw-Smith recurrence scheme.
-
-Reference: Yudell L. Luke. Mathematical functions and their approximations. Academic Press, N. Y., 1975.
-
-Usage:
- The polynomials are evaluated by functions named Ortho*, where * is one of P, G, H, L, T, U. The first argument of these functions is an integer. The series of polynomials are evaluated by functions named Ortho*Sum. The first argument of these functions is a list of coefficients. The last argument is the value x at which the polynomials are to be computed; if x is numerical, a faster routine is used.
-
- If n is an integer, n>=0, then:
- OrthoP(n, x) gives the n-th Legendre polynomial, evaluated on x
- OrthoP(n, a, b, x) gives the n-th Jacobi polynomial with parameters a, b, evaluated on x
- OrthoG(n, a, x) gives the n-th Gegenbauer polynomial
- OrthoH(n, x) gives the n-th Hermite polynomial
- OrthoL(n, a, x) gives the n-th Laguerre polynomial
- OrthoT(n, x) gives the n-th Tschebyscheff polynomial of the 1st kind
- OrthoU(n, x) gives the n-th Tschebyscheff polynomial of the 2nd kind
-
- If c is a list of coefficients c[1], c[2], ..., c[N], then Ortho*Sum(c, ...) where * is one of P, G, H, L, T, U, computes the sum of a series c[1]*P_0+c[2]*P_1+...+c[N]*P_N, where P_k is the relevant polynomial of k-th order. (For polynomials taking parameters: the parameters must remain constant throughout the summation.) Note that the intermediate polynomials are not evaluated and the recurrence relations are different for this computation, so there may be a numerical difference between Ortho*(c, ...) and computing the sum of the series directly.
-
- Internal functions that may be useful:
- OrthoPolyCoeffs(name_IsString, n_IsInteger, parameters_IsList) returns a list of coefficients of the polynomial. Here "name" must be one of the predefined names: "Jacobi", "Gegenbauer", "Hermite", "Laguerre", "Tscheb1", "Tscheb2"; and "parameters" is a list of extra parameters for the given family of polynomials, e.g. {a,b} for the Jacobi, {a} for Laguerre and {} for Hermite polynomials.
- OrthoPolySumCoeffs(name_IsString, c_IsList, parameters_IsList) returns a list of coefficients of the polynomial which is a sum of series with coefficients c.
- EvaluateHornerScheme(coefficients, x) returns the Horner-evaluated polynomial on x. The "coefficients" is a list that starts at the lowest power. For example, EvaluateHornerScheme({a,b,c}, x) should return (a+x*(b+x*c))
-*/
-
-10 # EvaluateHornerScheme({}, _x) <-- 0;
-/* Strictly speaking, the following rule is not needed, but it doesn't hurt */
-10 # EvaluateHornerScheme({_coeffs}, _x) <-- coeffs;
-20 # EvaluateHornerScheme(coeffs_IsList, _x) <-- First(coeffs)+x*EvaluateHornerScheme(Rest(coeffs), x);
-
-/* Plain polynomials */
-// some are computed by general routines, and some are replaced by more efficient routines below
-OrthoP(n_IsInteger, _x)_(n>=0) <-- OrthoP(n, 0, 0, x);
-OrthoP(n_IsInteger, a_IsRationalOrNumber, b_IsRationalOrNumber, _x)_(n>=0 And a> -1 And b> -1) <-- OrthoPoly("Jacobi", n, {a, b}, x);
-
-OrthoG(n_IsInteger, a_IsRationalOrNumber, _x)_(n>=0 And a> -1/2) <-- OrthoPoly("Gegenbauer", n, {a}, x);
-
-OrthoH(n_IsInteger, _x)_(n>=0) <-- OrthoPoly("Hermite", n, {}, x);
-
-OrthoL(n_IsInteger, a_IsRationalOrNumber, _x)_(n>=0 And a> -1) <-- OrthoPoly("Laguerre", n, {a}, x);
-
-OrthoT(n_IsInteger, _x)_(n>=0) <-- OrthoPoly("Tscheb1", n, {}, x);
-OrthoU(n_IsInteger, _x)_(n>=0) <-- OrthoPoly("Tscheb2", n, {}, x);
-
-/* Sums of series of orthogonal polynomials */
-
-OrthoPSum(c_IsList, _x) <-- OrthoP(c, 0, 0, x);
-OrthoPSum(c_IsList, a_IsRationalOrNumber, b_IsRationalOrNumber, _x)_(a> -1 And b> -1) <-- OrthoPolySum("Jacobi", c, {a, b}, x);
-
-OrthoGSum(c_IsList, a_IsRationalOrNumber, _x)_(a> -1/2) <-- OrthoPolySum("Gegenbauer", c, {a}, x);
-
-OrthoHSum(c_IsList, _x) <-- OrthoPolySum("Hermite", c, {}, x);
-
-OrthoLSum(c_IsList, a_IsRationalOrNumber, _x)_(a> -1) <-- OrthoPolySum("Laguerre", c, {a}, x);
-
-OrthoTSum(c_IsList, _x) <-- OrthoPolySum("Tscheb1", c, {}, x);
-OrthoUSum(c_IsList, _x) <-- OrthoPolySum("Tscheb2", c, {}, x);
-
-/*
-Orthogonal polynomials are evaluated using a general routine OrthoPolyCoeffs that generates their coefficients recursively.
-
-The recurrence relations start with n=0 and n=1 (the n=0 polynomial is always identically 1) and continue for n>=2. Note that the n=1 polynomial is not always given by the n=1 recurrence formula if we assume P_{-1}=0, so the recurrence should be considered undefined at n=1.
-
- For Legendre/Jacobi polynomials: (a>-1, b>-1)
-P(0,a,b,x):=1
-P(1,a,b,x):=(a-b)/2+x*(1+(a+b)/2)
-P(n,a,b,x):=(2*n+a+b-1)*(a^2-b^2+x*(2*n+a+b-2)*(2*n+a+b))/(2*n*(n+a+b)*(2*n+a+b-2))*P(n-1,a,b,x)-(n+a-1)*(n+b-1)*(2*n+a+b)/(n*(n+a+b)*(2*n+a+b-2))*P(n-2,a,b,x)
-
- For Hermite polynomials:
-H(0,x):=1
-H(1,x):=2*x
-H(n,x):=2*x*H(n-1,x)-2*(n-1)*H(n-2,x)
-
- For Gegenbauer polynomials: (a>-1/2)
-G(0,a,x):=1
-G(1,a,x):=2*a*x
-G(n,a,x):=2*(1+(a-1)/n)*x*G(n-1,a,x)-(1+2*(a-2)/n)*G(n-2,a,x)
-
- For Laguerre polynomials: (a>-1)
-L(0,a,x):=1
-L(1,a,x):=a+1-x
-L(n,a,x):=(2+(a-1-x)/n)*L(n-1,a,x)-(1+(a-1)/n)*L(n-2,a,x)
-
- For Tschebycheff polynomials of the first kind:
-T(0,x):=1
-T(1,x):=x
-T(n,x):=2*x*T(n-1,x)-T(n-2,x)
-
- For Tschebycheff polynomials of the second kind:
-U(0,x):=1
-U(1,x):=2*x
-U(n,x):=2*x*U(n-1,x)-U(n-2,x)
-
-The database "KnownOrthoPoly" contains closures that return coefficients for the recurrence relations of each family of polynomials. KnownOrthoPoly["name"] is a closure that takes two arguments: the order (n) and the extra parameters (p), and returns a list of two lists: the first list contains the coefficients {A,B} of the n=1 polynomial, i.e. "A+B*x"; the second list contains the coefficients {A,B,C} in the recurrence relation, i.e. "P_n = (A+B*x)*P_{n-1}+C*P_{n-2}". (So far there are only 3 coefficients in the second list, i.e. no "C+D*x", but we don't want to be limited.)
-
-*/
-
-LocalSymbols(knownOrthoPoly) [
- knownOrthoPoly := Hold({
- {"Jacobi", {{n, p}, {{(p[1]-p[2])/2, 1+(p[1]+p[2])/2}, {(2*n+p[1]+p[2]-1)*((p[1])^2-(p[2])^2)/(2*n*(n+p[1]+p[2])*(2*n+p[1]+p[2]-2)), (2*n+p[1]+p[2]-1)*(2*n+p[1]+p[2])/(2*n*(n+p[1]+p[2])), -(n+p[1]-1)*(n+p[2]-1)*(2*n+p[1]+p[2])/(n*(n+p[1]+p[2])*(2*n+p[1]+p[2]-2))}}}},
- {"Gegenbauer", {{n, p}, {{0, 2*p[1]}, {0, 2+2*(p[1]-1)/n, -1-2*(p[1]-1)/n}}}},
- {"Laguerre", {{n, p}, {{p[1]+1, -1}, {2+(p[1]-1)/n, -1/n, -1-(p[1]-1)/n}}}},
- {"Hermite", {{n, p}, {{0,2}, {0, 2, -2*(n-1)}}}},
- {"Tscheb1", {{n, p}, {{0,1}, {0,2,-1}}}},
- {"Tscheb2", {{n, p}, {{0,2}, {0,2,-1}}}}
- });
- KnownOrthoPoly() := knownOrthoPoly;
-
-]; // LocalSymbols(knownOrthoPoly)
-
-/*
-For efficiency, polynomials are represented by lists of coefficients rather than by MathPiper expressions. Polynomials are evaluated using the explicit Horner scheme. On numerical arguments, the polynomial coefficients are not computed, only the resulting value.
-*/
-
-/*
-Sums of series of orthogonal polynomials are found using the Clenshaw-Smith recurrence scheme:
- If $P_n$ satisfy $P_n = A_n p_{n-1} + B_n p_{n-2}$, $n>=2$, and if $A_1$ is defined so that $P_1 = A_1 P_0$, then $\sum _{n=0}^N c_n P_n = X_0 P_0$, where $X_n$ are found from the following backward recurrence: $X_{N+1} = X_{N+2} = 0$, $X_n = c_n + A_{n+1} X_{n+1} + B_{n+2} X_{n+2}$, $n=N, N-1, ..., 0$.
-*/
-
-/* Numeric arguments are processed by a faster routine */
-
-10 # OrthoPoly(name_IsString, _n, p_IsList, x_IsRationalOrNumber) _ (KnownOrthoPoly()[name] != Empty) <-- OrthoPolyNumeric(name, n, p, x);
-20 # OrthoPoly(name_IsString, _n, p_IsList, _x) _ (KnownOrthoPoly()[name] != Empty) <-- EvaluateHornerScheme(OrthoPolyCoeffs(name, n, p), x);
-
-10 # OrthoPolySum(name_IsString, c_IsList, p_IsList, x_IsRationalOrNumber) _ (KnownOrthoPoly()[name] != Empty) <-- OrthoPolySumNumeric(name, c, p, x);
-20 # OrthoPolySum(name_IsString, c_IsList, p_IsList, _x) _ (KnownOrthoPoly()[name] != Empty) <-- EvaluateHornerScheme(OrthoPolySumCoeffs(name, c, p), x);
-
-/*
-OrthoPolyNumeric computes the value of the polynomial from recurrence relations directly. Do not use with non-numeric arguments, except for testing!
-*/
-OrthoPolyNumeric(name_IsString, n_IsInteger, p_IsList, _x) <-- [
- Local(value1, value2, value3, ruleCoeffs, index);
- value1 := 1;
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {n, p})[1];
- value2 := ruleCoeffs[1] + x*ruleCoeffs[2];
- index := 1;
- /* value1, value2, value3 is the same as P_{n-2}, P_{n-1}, P_n where n = index */
- While(index=1) [
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {index+1, p})[2];
- ruleCoeffs1 := Apply(KnownOrthoPoly()[name], {index+2, p})[2];
- value3 := (ruleCoeffs[1] + x*ruleCoeffs[2])*value2 + ruleCoeffs1[3]*value1 + c[index+1];
- value1 := value2;
- value2 := value3;
- index := index - 1;
- ];
- /* Last iteration by hand: works correctly also if c has only 1 element */
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {1, p})[1];
- ruleCoeffs1 := Apply(KnownOrthoPoly()[name], {2, p})[2];
- value2 := (ruleCoeffs[1] + x*ruleCoeffs[2])*value2 + ruleCoeffs1[3]*value1 + c[1];
- value2;
-];
-
-/*
-OrthoPolyCoeffs(name, n, p) returns the list of coefficients for orthogonal polynomials, starting with the lowest powers.
-*/
-
-10 # OrthoPolyCoeffs(name_IsString, 0, p_IsList) <-- {1};
-10 # OrthoPolyCoeffs(name_IsString, 1, p_IsList) <-- Apply(KnownOrthoPoly()[name], {1, p})[1];
-
-/* Simple implementation, very slow, for testing only: recursive rule matches, no loops
-20 # OrthoPolyCoeffs(name_IsString, n_IsInteger, p_IsList)_(n>1) <-- [
- Local(ruleCoeffs, newCoeffs);
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {n, p})[2];
- newCoeffs := OrthoPolyCoeffs(name, n-1, p);
- Concat(newCoeffs,{0})*ruleCoeffs[1] + Concat(OrthoPolyCoeffs(name, n-2, p),{0,0})*ruleCoeffs[3] + Concat({0}, newCoeffs)*ruleCoeffs[2];
-];
-*/
-
-/* A fast implementation that works directly with lists and saves memory. Same recurrence as in OrthoPolyNumeric() */
-/* note: here we pass "name" instead of "KnownOrthoPoly()[name]" for efficiency, but strictly speaking we don't need to use this global constant */
-
-20 # OrthoPolyCoeffs(name_IsString, n_IsInteger, p_IsList)_(n>1) <-- [
- Local(ruleCoeffs, tmpCoeffs, newCoeffs, prevCoeffs, index, jndex, tmptmpCoeffs, prevCoeffsA, newCoeffsA, tmpCoeffsA);
- /* For speed, allocate all lists now. Length is n+1 */
- prevCoeffsA := ZeroVector(n+1);
- newCoeffsA := ZeroVector(n+1);
- tmpCoeffsA := ZeroVector(n+1);
- /* pointers to arrays */
- prevCoeffs := prevCoeffsA;
- newCoeffs := newCoeffsA;
- tmpCoeffs := tmpCoeffsA;
- /* Initialize: n=0 and n=1 */
- prevCoeffs[1] := 1;
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {n, p})[1];
- newCoeffs[1] := ruleCoeffs[1];
- newCoeffs[2] := ruleCoeffs[2];
- /* Invariant: answer ready in "newCoeffs" at value of index */
- index := 1;
- /* main loop */
- While(index < n) [
- index := index + 1;
- /* Echo({"index ", index}); */ /* in case this is slow */
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {index, p})[2];
- tmpCoeffs[1] := ruleCoeffs[1]*newCoeffs[1] + ruleCoeffs[3]*prevCoeffs[1];
- /* The polynomial tmpCoeffs must have (index+1) coefficients now */
- For(jndex:=2, jndex <= index, jndex:=jndex+1) [
- tmpCoeffs[jndex] := ruleCoeffs[1]*newCoeffs[jndex] + ruleCoeffs[3]*prevCoeffs[jndex] + ruleCoeffs[2]*newCoeffs[jndex-1];
- ];
- tmpCoeffs[index+1] := ruleCoeffs[2]*newCoeffs[index];
-/*
- prevCoeffs := FlatCopy(newCoeffs);
- newCoeffs := FlatCopy(tmpCoeffs);
-*/
-/* juggle pointers instead of copying lists */
- tmptmpCoeffs := prevCoeffs;
- prevCoeffs := newCoeffs;
- newCoeffs := tmpCoeffs;
- tmpCoeffs := tmptmpCoeffs;
- ];
- newCoeffs;
-];
-
-/*
-OrthoPolySumCoeffs(name, c, p) returns the list of coefficients for the sum of a series of orthogonal polynomials. Same recurrence as in OrthoPolySumNumeric()
-*/
-
-OrthoPolySumCoeffs(name_IsString, c_IsList, p_IsList) <-- [
- Local(n, ruleCoeffs, ruleCoeffs1, tmpCoeffs, newCoeffs, prevCoeffs, index, jndex, tmptmpCoeffs, prevCoeffsA, newCoeffsA, tmpCoeffsA);
- /* n is the max polynomial order we need */
- n := Length(c) - 1;
- /* For speed, allocate all lists now. Length is n+1 */
- prevCoeffsA := ZeroVector(n+1);
- newCoeffsA := ZeroVector(n+1);
- tmpCoeffsA := ZeroVector(n+1);
- /* pointers to arrays */
- prevCoeffs := prevCoeffsA;
- newCoeffs := newCoeffsA;
- tmpCoeffs := tmpCoeffsA;
- /* Invariant: answer ready in "newCoeffs" at value of index */
- /* main loop */
- For(index:=n, index >= 1, index:=index-1) [
- /* Echo({"index ", index}); */ /* in case this is slow */
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {index+1, p})[2];
- ruleCoeffs1 := Apply(KnownOrthoPoly()[name], {index+2, p})[2];
- tmpCoeffs[1] := c[index+1] + ruleCoeffs[1]*newCoeffs[1] + ruleCoeffs1[3]*prevCoeffs[1];
- /* The polynomial tmpCoeffs must have (n-index+1) coefficients now */
- For(jndex:=2, jndex <= n-index, jndex:=jndex+1) [
- tmpCoeffs[jndex] := ruleCoeffs[1]*newCoeffs[jndex] + ruleCoeffs1[3]*prevCoeffs[jndex] + ruleCoeffs[2]*newCoeffs[jndex-1];
- ];
- If(n-index>0, tmpCoeffs[n-index+1] := ruleCoeffs[2]*newCoeffs[n-index]);
-/*
- prevCoeffs := FlatCopy(newCoeffs);
- newCoeffs := FlatCopy(tmpCoeffs);
-*/
-/* juggle pointers instead of copying lists */
- tmptmpCoeffs := prevCoeffs;
- prevCoeffs := newCoeffs;
- newCoeffs := tmpCoeffs;
- tmpCoeffs := tmptmpCoeffs;
- ];
- /* Last iteration by hand: works correctly also if c has only 1 element */
- index:=0;
- ruleCoeffs := Apply(KnownOrthoPoly()[name], {index+1, p})[1];
- ruleCoeffs1 := Apply(KnownOrthoPoly()[name], {index+2, p})[2];
- tmpCoeffs[1] := c[index+1] + ruleCoeffs[1]*newCoeffs[1] + ruleCoeffs1[3]*prevCoeffs[1];
- /* The polynomial tmpCoeffs must have (n-index+1) coefficients now */
- For(jndex:=2, jndex <= n-index, jndex:=jndex+1) [
- tmpCoeffs[jndex] := ruleCoeffs[1]*newCoeffs[jndex] + ruleCoeffs1[3]*prevCoeffs[jndex] + ruleCoeffs[2]*newCoeffs[jndex-1];
- ];
- tmpCoeffs[n-index+1] := ruleCoeffs[2]*newCoeffs[n-index];
- tmpCoeffs;
-];
-
-//////////////////////////////////////////////////
-/// Very fast computation of Chebyshev polynomials
-//////////////////////////////////////////////////
-/// (This is not used now because of numerical instability, until I figure out how much to increase the working precision to get P correct digits.)
-/// See: W. Koepf. Efficient computation of Chebyshev polynomials in computer algebra (unpublished preprint). Contrary to Koepf's claim (unsupported by any calculation in his paper) that the method is numerically stable, I found unsatisfactory numerical behavior for very large orders.
-/// Koepf suggests to use M. Bronstein's algorithm for finding rational solutions of linear ODEs for all other orthogonal polynomials (may be faster than recursion if we want to find the analytic form of the polynomial, but still slower if an explicit formula is available).
-//////////////////////////////////////////////////
-/// Main formulae: T(2*n,x) = 2*T(n,x)^2-1; T(2*n+1,x) = 2*T(n+1,x)*T(n,x)-x;
-/// U(2*n,x) = 2*T(n,x)*U(n,x)-1; T(2*n+1,x) = 2*T(n+1,x)*U(n,x);
-/// We avoid recursive calls and build the sequence of bits of n to determine the minimal sequence of n[i] for which T(n[i], x) and U(n[i], x) need to be computed
-//////////////////////////////////////////////////
-/*
-/// This function will return the list of binary bits, e.g. BitList(10) returns {1,0,1,0}.
-BitList(n) := BitList(n, {});
-/// This will not be called on very large numbers so it's okay to use recursion
-1# BitList(0, _bits) <-- bits;
-2# BitList(_n, _bits) <-- BitList(Div(n,2), Push(bits, Mod(n,2)));
-
-// Tchebyshev polynomials of 1st kind
-1 # FastOrthoT(0, _x) <-- 1;
-1 # FastOrthoT(1, _x) <-- x;
-// Tchebyshev polynomials of 2nd kind
-1 # FastOrthoU(0, _x) <-- 1;
-1 # FastOrthoU(1, _x) <-- 2*x;
-
-// guard against user errors
-2 # FastOrthoT(_n, _x) _ (IsInteger(n) And n<0) <-- Undefined;
-2 # FastOrthoU(_n, _x) _ (IsInteger(n) And n<0) <-- Undefined;
-
-// make T(), U() of even order more efficient: delegate gruntwork to odd order
-2 # FastOrthoT(n_IsEven, _x) <-- 2*FastOrthoT(Div(n,2), x)^2-1;
-2 # FastOrthoU(n_IsEven, _x) <-- 2*FastOrthoT(Div(n,2), x)*FastOrthoU(Div(n,2), x)-1;
-
-// FastOrthoT() of odd order
-3 # FastOrthoT(n_IsOdd, _x) <--
-[
- Local(T1, T2, i);
- // first bit in the list is always 1, so initialize the pair
- T1 := FastOrthoT(1, x);
- T2 := FastOrthoT(2, x);
- ForEach(i, Rest(BitList(n))) // skip first bit
- [
- // if the current bit is 1, we need to double the second index, else double the first index.
- // Invariant: n[i+1] = 2*n[i] + BitList[i] and we need to have FastOrthoT(n[i]), FastOrthoT(1+n[i]) as T1, T2. Initially n[1]=1 and after the cycle n[i]=n.
- {T1, T2} := If
- (
- i=1,
- {2*T1*T2-x, 2*T2^2-1},
- {2*T1^2-1, 2*T1*T2-x}
- );
- ];
- T1;
-];
-
-// FastOrthoU() of any order
-3 # FastOrthoU(_n, _x) <--
-[
- Local(U1, T1, T2, i);
- // first bit in the list is always 1, so initialize the pair
- U1 := FastOrthoU(1, x);
- T1 := FastOrthoT(1, x);
- T2 := FastOrthoT(2, x);
- ForEach(i, Rest(BitList(n))) // skip first bit
- [
- // if the current bit is 1, we need to double the second index, else double the first index
- // Invariant: n[i+1] = 2*n[i] + BitList[i] and we need to have U(n[i]), T(n[i]), T(1+n[i]) as U1, T1, T2. Initially n[1]=1 and after the cycle n[i]=n.
- {U1, T1, T2} := If
- (
- i=1,
- {2*U1*T2, 2*T1*T2-x, 2*T2^2-1},
- {2*U1*T1-1, 2*T1^2-1, 2*T1*T2-x}
- );
- ];
- U1;
-];
-*/
-//////////////////////////////////////////////////
-/// Fast symbolic computation of some polynomials
-//////////////////////////////////////////////////
-
-
-//////////////////////////////////////////////////
-/// Fast symbolic computation of Legendre polynomials
-//////////////////////////////////////////////////
-
-8# OrthoPolyCoeffs("Jacobi", n_IsInteger, {0,0}) <--
-[
- Local(i, result);
- result := ZeroVector(n+1);
- result[n+1] := (2*n-1)!! /n!; // coefficient at x^n
- i := 1;
- While(2*i<=n)
- [ // prepare coefficient at x^(n-2*i) now
- result[n+1-2*i] := -(result[n+3-2*i]*(n-2*i+1)*(n-2*i+2)) / ((2*n-2*i+1)*2*i);
- i++;
- ];
- result;
-];
-
-//////////////////////////////////////////////////
-/// Fast symbolic computation of Hermite polynomials
-//////////////////////////////////////////////////
-
-OrthoPolyCoeffs("Hermite", n_IsInteger, {}) <-- HermiteCoeffs(n);
-
-/// Return the list of coefficiets of Hermite polynomials.
-HermiteCoeffs(n_IsEven)_(n>0) <--
-[
- Local(i, k, result);
- k := Div(n,2);
- result := ZeroVector(n+1);
- result[1] := (-2)^k*(n-1)!!; // coefficient at x^0
- For(i:=1,i<=k,i++) // prepare coefficient at x^(2*i) now
- result[2*i+1] := Div(-2*result[2*i-1] * (k-i+1), (2*i-1)*i); // this division is always integer but faster with Div()
- result;
-];
-HermiteCoeffs(n_IsOdd)_(n>0) <--
-[
- Local(i, k, result);
- k := Div(n,2);
- result := ZeroVector(n+1);
- result[2] := 2*(-2)^k*(n!!); // coefficient at x^1
- For(i:=1,i<=k,i++) // prepare coefficient at x^(2*i+1) now
- result[2*i+2] := Div(-2*result[2*i] * (k-i+1), i*(2*i+1)); // this division is always integer but faster with Div()
- result;
-];
-
-//////////////////////////////////////////////////
-/// Fast symbolic computation of Laguerre polynomials
-//////////////////////////////////////////////////
-
-/// Return the list of coefficients of Laguerre polynomials.
-OrthoPolyCoeffs("Laguerre", n_IsInteger, {_k}) <--
-[
- Local(i, result);
- result := ZeroVector(n+1);
- result[n+1] := (-1)^n/n!; // coefficient at x^n
- For(i:=n,i>=1,i--) // prepare coefficient at x^(i-1) now
- result[i] := -(result[i+1]*i*(k+i))/(n-i+1);
- result;
-];
-
-
-//////////////////////////////////////////////////
-/// Fast symbolic computation of Chebyshev polynomials
-//////////////////////////////////////////////////
-
-OrthoPolyCoeffs("Tscheb1", n_IsInteger, {}) <-- ChebTCoeffs(n);
-OrthoPolyCoeffs("Tscheb2", n_IsInteger, {}) <-- ChebUCoeffs(n);
-
-1 # ChebTCoeffs(0) <-- {1};
-2 # ChebTCoeffs(n_IsInteger) <--
-[
- Local(i, result);
- result := ZeroVector(n+1);
- result[n+1] := 2^(n-1); // coefficient at x^n
- i := 1;
- While(2*i<=n)
- [ // prepare coefficient at x^(n-2*i) now
- result[n+1-2*i] := -(result[n+3-2*i]*(n-2*i+2)*(n-2*i+1)) / ((n-i)*4*i);
- i++;
- ];
- result;
-];
-
-1 # ChebUCoeffs(0) <-- {1};
-2 # ChebUCoeffs(n_IsInteger) <--
-[
- Local(i, result);
- result := ZeroVector(n+1);
- result[n+1] := 2^n; // coefficient at x^n
- i := 1;
- While(2*i<=n)
- [ // prepare coefficient at x^(n-2*i) now
- result[n+1-2*i] := -(result[n+3-2*i]*(n-2*i+2)*(n-2*i+1)) / ((n-i+1)*4*i);
- i++;
- ];
- result;
-];
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="EvaluateHornerScheme",categories="User Functions;Polynomials (Operations)"
-*CMD EvaluateHornerScheme --- fast evaluation of polynomials
-*STD
-*CALL
- EvaluateHornerScheme(coeffs,x)
-
-*PARMS
-
-{coeffs} -- a list of coefficients
-
-{x} -- expression
-
-*DESC
-
-This function evaluates a polynomial given as a list of its coefficients, using
-the Horner scheme. The list of coefficients starts with the $0$-th power.
-
-*E.G.
-
- In> EvaluateHornerScheme({a,b,c,d},x)
- Out> a+x*(b+x*(c+x*d));
-
-*SEE Horner
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoP",categories="User Functions;Polynomials (Special)"
-*CMD OrthoP --- Legendre and Jacobi orthogonal polynomials
-*STD
-*CALL
- OrthoP(n, x);
- OrthoP(n, a, b, x);
-
-*PARMS
-
-{n} -- degree of polynomial
-
-{x} -- point to evaluate polynomial at
-
-{a}, {b} -- parameters for Jacobi polynomial
-
-*DESC
-
-The first calling format with two arguments evaluates the Legendre polynomial
-of degree {n} at the point {x}. The second form does the same for the Jacobi
-polynomial with parameters {a} and {b}, which should be both greater than -1.
-
-The Jacobi polynomials are orthogonal with respect to the weight
-function $(1-x)^a *(1+x)^b$ on the interval [-1,1]. They satisfy the
-recurrence relation
-$$P(n,a,b,x) = (2*n+a+b-1)/(2*n+a+b-2) $$*
-$$ ((a^2-b^2+x*(2*n+a+b-2)*(n+a+b))/(2*n*(n+a+b))) * P(n-1,a,b,x)$$
-$$ - ((n+a-1)*(n+b-1)*(2*n+a+b))/(n*(n+a+b)*(2*n+a+b-2))*P(n-2,a,b,x)$$
-for $n > 1$, with
-$P(0,a,b,x) = 1$,
-$$P(1,a,b,x) = (a-b)/2+x*(1+(a+b)/2)$$.
-
-*REM (old versions of the equations:)
-// P(0,a,b,x) = 1,
-//
-// a - b / a + b \
-// P(1,a,b,x) = ----- + x | 1 + ----- | ,
-// 2 \ 2 /
-//
-//
-//
-// P(n,a,b,x) = (2n + a + b - 1) *
-//
-//
-// 2 2
-// a - b + x (2n+a+b-2) (n+a+b)
-// ---------------------------- P(n-1,a,b,x)
-// 2n (2n+a+b-2) (n+a+b)
-//
-// (n+a-1) (n+b-1) (2n+a+b)
-// - ------------------------ P(n-2,a,b,x)
-// n (n+a+b) (2n+a+b-2)
-
-Legendre polynomials are a special case of Jacobi polynomials with the
-specific parameter values $a = b = 0$. So they form an orthogonal system
-with respect to the weight function identically equal to 1 on the
-interval [-1,1], and they satisfy the recurrence relation
-$$ P(n,x)=((2*n-1)*x/(2*n))*P(n-1,x)-(n-1)/n*P(n-2,x) $$
-for $n > 1$, with
-$ P(0,x)=1 $,
-$ P(1,x)=x $.
-
-*REM
-// P(0,x) = 1
-//
-// P(1,x) = x
-//
-// (2n - 1) x n - 1
-// P(n,x) = ---------- P(n-1,x) - ----- P(n-2,x),
-// 2n n
-
-Most of the work is performed by the internal function {OrthoPoly}.
-
-*E.G.
-
- In> PrettyPrinter'Set("PrettyForm");
-
- True
-
- In> OrthoP(3, x);
-
- / 2 \
- | 5 * x 3 |
- x * | ------ - - |
- \ 2 2 /
-
- In> OrthoP(3, 1, 2, x);
-
- 1 / / 21 * x 7 \ 7 \
- - + x * | x * | ------ - - | - - |
- 2 \ \ 2 2 / 2 /
-
- In> Expand(%)
-
- 3 2
- 21 * x - 7 * x - 7 * x + 1
- ----------------------------
- 2
-
- In> OrthoP(3, 1, 2, 0.5);
-
- -0.8124999999
-
-
-*SEE OrthoPSum, OrthoG, OrthoPoly
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoH",categories="User Functions;Polynomials (Special)"
-*CMD OrthoH --- Hermite orthogonal polynomials
-*STD
-*CALL
- OrthoH(n, x);
-
-*PARMS
-
-{n} -- degree of polynomial
-
-{x} -- point to evaluate polynomial at
-
-*DESC
-
-This function evaluates the Hermite polynomial of degree {n} at the
-point {x}.
-
-The Hermite polynomials are orthogonal with respect to the weight
-function $Exp(-x^2/2)$ on the entire real axis. They satisfy the
-recurrence relation
-$$ H(n,x) = 2*x*H(n-1,x) - 2*(n-1)*H(n-2,x) $$
-for $n > 1$, with
-$H(0,x) = 1$,
-$H(1,x) = 2*x$.
-
-Most of the work is performed by the internal function {OrthoPoly}.
-
-*E.G.
-
- In> OrthoH(3, x);
- Out> x*(8*x^2-12);
- In> OrthoH(6, 0.5);
- Out> 31;
-
-*SEE OrthoHSum, OrthoPoly
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoG",categories="User Functions;Polynomials (Special)"
-*CMD OrthoG --- Gegenbauer orthogonal polynomials
-*STD
-*CALL
- OrthoG(n, a, x);
-
-*PARMS
-
-{n} -- degree of polynomial
-
-{a} -- parameter
-
-{x} -- point to evaluate polynomial at
-
-*DESC
-
-This function evaluates the Gegenbauer (or ultraspherical) polynomial
-with parameter {a} and degree {n} at the point {x}. The
-parameter {a} should be greater than -1/2.
-
-The Gegenbauer polynomials are orthogonal with respect to the weight
-function $(1-x^2)^(a-1/2)$ on the interval [-1,1]. Hence they are
-connected to the Jacobi polynomials via
-$$ G(n, a, x) = P(n, a-1/2, a-1/2, x) $$.
-They satisfy the recurrence relation
-$$ G(n,a,x) = 2*(1+(a-1)/n)*x*G(n-1,a,x) $$
-$$ -(1+2*(a-2)/n)*G(n-2,a,x) $$
-for $n>1$, with
-$G(0,a,x) = 1$,
-$G(1,a,x) = 2*x$.
-
-*REM
-// / a - 1 \
-// G(n,a,x) = 2 | 1 + ----- | x G(n-1,a,x)
-// \ n /
-//
-// / 2 (a-2) \
-// - | 1 + ------- | G(n-2,a,x),
-// \ n /
-
-Most of the work is performed by the internal function {OrthoPoly}.
-
-*E.G.
-
- In> OrthoG(5, 1, x);
- Out> x*((32*x^2-32)*x^2+6);
- In> OrthoG(5, 2, -0.5);
- Out> 2;
-
-*SEE OrthoP, OrthoT, OrthoU, OrthoGSum, OrthoPoly
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoL",categories="User Functions;Polynomials (Special)"
-*CMD OrthoL --- Laguerre orthogonal polynomials
-*STD
-*CALL
- OrthoL(n, a, x);
-
-*PARMS
-
-{n} -- degree of polynomial
-
-{a} -- parameter
-
-{x} -- point to evaluate polynomial at
-
-*DESC
-
-This function evaluates the Laguerre polynomial with parameter {a}
-and degree {n} at the point {x}. The parameter {a} should be
-greater than -1.
-
-The Laguerre polynomials are orthogonal with respect to the weight
-function $x^a * Exp(-x)$ on the positive real axis. They satisfy the
-recurrence relation
-$$ L(n,a,x) = (2+(a-1-x)/n)* L(n-1,a,x) $$
-$$ -(1-(a-1)/n)*L(n-2,a,x) $$
-for $n>1$, with
-$L(0,a,x) = 1$,
-$L(1,a,x) = a + 1 - x$.
-
-*REM
-// / a - 1 - x \
-// L(n,a,x) = | 2 + --------- | L(n-1,a,x) -
-// \ n /
-//
-// / a - 1 \
-// | 1 + ----- | L(n-2,a,x),
-// \ n /
-
-
-Most of the work is performed by the internal function {OrthoPoly}.
-
-*E.G.
-
- In> OrthoL(3, 1, x);
- Out> x*(x*(2-x/6)-6)+4;
- In> OrthoL(3, 1/2, 0.25);
- Out> 1.2005208334;
-
-*SEE OrthoLSum, OrthoPoly
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoT;OrthoU",categories="User Functions;Polynomials (Special)"
-*CMD OrthoT --- Chebyshev polynomials
-*CMD OrthoU --- Chebyshev polynomials
-*STD
-*CALL
- OrthoT(n, x);
- OrthoU(n, x);
-
-*PARMS
-
-{n} -- degree of polynomial
-
-{x} -- point to evaluate polynomial at
-
-*DESC
-
-These functions evaluate the Chebyshev polynomials of the first kind
-$T(n,x)$ and of the second kind $U(n,x)$, of degree "n" at the point "x". (The
-name of this Russian mathematician is also sometimes spelled "Tschebyscheff".)
-
-The Chebyshev polynomials are orthogonal with respect to the weight
-function $(1-x^2)^(-1/2)$. Hence they are a special case of the Gegenbauer
-polynomials $G(n,a,x)$, with $a=0$. They satisfy the recurrence relations
-$$ T(n,x) = 2* x* T(n-1,x) - T(n-2,x) $$,
-$$ U(n,x) = 2* x* U(n-1,x) - U(n-2,x) $$
-for $n > 1$, with
-$T(0,x) = 1$,
-$T(1,x) = x$,
-$U(0,x) = 1$,
-$U(1,x) = 2*x$.
-
-
-*E.G.
-
- In> OrthoT(3, x);
- Out> 2*x*(2*x^2-1)-x;
- In> OrthoT(10, 0.9);
- Out> -0.2007474688;
- In> OrthoU(3, x);
- Out> 4*x*(2*x^2-1);
- In> OrthoU(10, 0.9);
- Out> -2.2234571776;
-
-
-*SEE OrthoG, OrthoTSum, OrthoUSum, OrthoPoly
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoPSum;OrthoHSum;OrthoLSum;OrthoGSum;OrthoTSum;OrthoUSum",categories="User Functions;Polynomials (Special)"
-*CMD OrthoPSum --- sums of series of orthogonal polynomials
-*CMD OrthoHSum --- sums of series of orthogonal polynomials
-*CMD OrthoLSum --- sums of series of orthogonal polynomials
-*CMD OrthoGSum --- sums of series of orthogonal polynomials
-*CMD OrthoTSum --- sums of series of orthogonal polynomials
-*CMD OrthoUSum --- sums of series of orthogonal polynomials
-*STD
-*CALL
- OrthoPSum(c, x);
- OrthoPSum(c, a, b, x);
- OrthoHSum(c, x);
- OrthoLSum(c, a, x);
- OrthoGSum(c, a, x);
- OrthoTSum(c, x);
- OrthoUSum(c, x);
-
-*PARMS
-
-{c} -- list of coefficients
-
-{a}, {b} -- parameters of specific polynomials
-
-{x} -- point to evaluate polynomial at
-
-*DESC
-
-These functions evaluate the sum of series of orthogonal polynomials at the point {x}, with given list of coefficients {c} of the series and fixed polynomial parameters {a}, {b} (if applicable).
-
-The list of coefficients starts with the lowest order, so that for example
-OrthoLSum(c, a, x) = c[1] L[0](a,x) + c[2] L[1](a,x) + ... + c[N] L[N-1](a,x).
-
-See pages for specific orthogonal polynomials for more details on the parameters of the polynomials.
-
-Most of the work is performed by the internal function {OrthoPolySum}. The individual polynomials entering the series are not computed, only the sum of the series.
-
-*E.G.
-
- In> Expand(OrthoPSum({1,0,0,1/7,1/8}, 3/2, \
- 2/3, x));
- Out> (7068985*x^4)/3981312+(1648577*x^3)/995328+
- (-3502049*x^2)/4644864+(-4372969*x)/6967296
- +28292143/27869184;
-
-*SEE OrthoP, OrthoG, OrthoH, OrthoL, OrthoT, OrthoU, OrthoPolySum
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoPoly",categories="User Functions;Polynomials (Special)"
-*CMD OrthoPoly --- internal function for constructing orthogonal polynomials
-*STD
-*CALL
- OrthoPoly(name, n, par, x)
-
-*PARMS
-
-{name} -- string containing name of orthogonal family
-
-{n} -- degree of the polynomial
-
-{par} -- list of values for the parameters
-
-{x} -- point to evaluate at
-
-*DESC
-
-This function is used internally to construct orthogonal
-polynomials. It returns the {n}-th polynomial from the family
-{name} with parameters {par} at the point {x}.
-
-All known families are stored in the association list returned by the function {KnownOrthoPoly()}. The name serves as key. At the moment
-the following names are known to MathPiper: {"Jacobi"}, {"Gegenbauer"}, {"Laguerre"}, {"Hermite"}, {"Tscheb1"},
-and {"Tscheb2"}. The value associated to the key
-is a pure function that takes two arguments: the order {n} and the
-extra parameters {p}, and returns a list of two lists: the first list
-contains the coefficients {A,B} of the n=1 polynomial, i.e. $A+B*x$;
-the second list contains the coefficients {A,B,C} in the recurrence
-relation, i.e. $P[n] = (A+B*x)*P[n-1]+C*P[n-2]$. (There are
-only 3 coefficients in the second list, because none of the polynomials use $C+D*x$ instead of $C$ in the recurrence relation. This is assumed in the implementation!)
-
-If the argument {x} is numerical, the function {OrthoPolyNumeric} is called. Otherwise, the function {OrthoPolyCoeffs} computes a list of coefficients, and
-{EvaluateHornerScheme} converts this list into a
-polynomial expression.
-
-*SEE OrthoP, OrthoG, OrthoH, OrthoL, OrthoT, OrthoU, OrthoPolySum
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="OrthoPolySum",categories="User Functions;Polynomials (Special)"
-*CMD OrthoPolySum --- internal function for computing series of orthogonal polynomials
-*STD
-*CALL
- OrthoPolySum(name, c, par, x)
-
-*PARMS
-
-{name} -- string containing name of orthogonal family
-
-{c} -- list of coefficients
-
-{par} -- list of values for the parameters
-
-{x} -- point to evaluate at
-
-*DESC
-
-This function is used internally to compute series of orthogonal polynomials.
-It is similar to the function {OrthoPoly} and returns the result of the
-summation of series of polynomials from the family {name} with parameters {par}
-at the point {x}, where {c} is the list of coefficients of the series.
-
-The algorithm used to compute the series without first computing the individual polynomials is the Clenshaw-Smith recurrence scheme.
-(See the algorithms book for explanations.)
-
-If the argument {x} is numerical, the function {OrthoPolySumNumeric} is called.
-Otherwise, the function {OrthoPolySumCoeffs} computes the list of coefficients
-of the resulting polynomial, and {EvaluateHornerScheme} converts this list into
-a polynomial expression.
-
-*SEE OrthoPSum, OrthoGSum, OrthoHSum, OrthoLSum, OrthoTSum, OrthoUSum, OrthoPoly
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/Apart.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/Apart.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/Apart.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/Apart.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,27 +0,0 @@
-%mathpiper,def="Apart"
-
-Apart(_f) <-- Apart(f,x);
-
-Apart(_f,_var) <--
-[
- Local(rat);
- rat:=RationalForm(f,var);
- If(Degree(rat[1],var) = 0 And Degree(rat[2],var) = 0,
- [
- rat:={Coef(rat[1],var,0),Coef(rat[2],var,0)};
- Local(summed,add);
- summed := Eval(PartFracExpand(Rem(rat[1],rat[2]),rat[2]));
- add:=(rat[1]/rat[2] - summed);
- add + summed;
- ]
- ,
- [
- /*TODO check this one! Do we have to do the same as with the
- * integers?
- */
- Expand(Div(rat[1],rat[2])) + PartFracExpand(Rem(rat[1],rat[2]),rat[2]);
- ]
- );
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ChineseRemainderInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ChineseRemainderInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ChineseRemainderInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ChineseRemainderInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,26 +0,0 @@
-%mathpiper,def="ChineseRemainderInteger"
-
-/* Chinese Remaindering algorithm, as described in "Modern Computer Algebra".
- */
-ChineseRemainderInteger(mlist_IsList,vlist_IsList) <--
-[
- Local(m,i,nr,result,msub,euclid,clist);
- clist:={};
- m:=Product(mlist);
- result:=0;
-
- nr:=Length(mlist);
- For(i:=1,i<=nr,i++)
- [
- msub:=Div(m,mlist[i]);
- euclid := ExtendedEuclidean(msub,mlist[i]);
- Local(c);
- c:=vlist[i] * euclid[2];
- c:=Rem(c, mlist[i]);
- DestructiveAppend(clist,c);
- result:=result + msub * c;
- ];
- {result,clist};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ChineseRemainderPoly.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ChineseRemainderPoly.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ChineseRemainderPoly.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ChineseRemainderPoly.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="ChineseRemainderPoly"
-
-ChineseRemainderPoly(mlist_IsList,vlist_IsList) <--
-[
- Local(m,i,nr,result,msub,euclid,clist);
- clist:={};
- m:=Product(mlist);
- result:=0;
-
-/* Echo({mlist,m}); */
-
-
- nr:=Length(mlist);
- For(i:=1,i<=nr,i++)
- [
- msub:=Div(m,mlist[i]);
-
-/* Echo({Factor(msub)}); */
-
- euclid := ExtendedEuclideanMonic(msub,mlist[i]);
- Local(c);
-
- c:=vlist[i] * euclid[2];
-
- c:=Mod(c, mlist[i]);
-
- DestructiveAppend(clist,c);
- result:=result + msub * c;
- ];
- {Expand(result),clist};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ExtendedEuclideanMonic.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ExtendedEuclideanMonic.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ExtendedEuclideanMonic.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ExtendedEuclideanMonic.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="ExtendedEuclideanMonic"
-
-ExtendedEuclideanMonic(_f,_g) <--
-[
- Local(rho,r,s,t,i);
-
-/*
-Echo({f,g});
-Echo({});
-*/
-
- /* Initialize the loop */
- rho:={LeadingCoef(f),LeadingCoef(g)};
- r:={Monic(f),Monic(g)};
- s:={1/(rho[1]),0};
- t:={0,1/(rho[2])};
- i:=1;
-
- Local(q,newr,news,newt,newrho);
- newr:=r[2];
- While(newr != 0)
- [
- q :=Div(r[i],r[i+1]);
- newr:=Mod(r[i],r[i+1]);
- newrho:=LeadingCoef(newr);
-
-
- If (newr != 0, newr:=Monic(newr));
- news :=(s[i]-q*s[i+1]);
- newt :=(t[i]-q*t[i+1]);
- If(newrho != 0,
- [
- news:=news/newrho;
- newt:=newt/newrho;
- ]);
- DestructiveAppend(rho,newrho);
- DestructiveAppend(r ,newr);
- DestructiveAppend(s,news);
- DestructiveAppend(t,newt);
- i++;
- ];
-
-/*
-TableForm({i,r,s,t});
-Echo({});
-*/
-
- {r[i],s[i],t[i]};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ExtendedEuclidean.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ExtendedEuclidean.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/ExtendedEuclidean.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/ExtendedEuclidean.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def="ExtendedEuclidean"
-
-/* Extended Euclidean algorithm. Algorithm taken from
- * "Modern Computer Algebra". It does a Gcd calculation, but
- * returns the intermediate results also.
- *
- * Returns {l,r,s,t}
- * where
- * - l the number of steps required
- * - r[i] the i-th remainder
- * - s[i] and t[i] the i-th bezout coefficients of f and g:
- s[i]*f + t[i]*g = r[i] .
- * The gcd is r[l].
- *
- * This is a slightly modified version from the one described in
- * "Modern Computer Algebra", where the elements in list r are not
- * monic. If needed this can be done afterwards. As a consequence
- * this version works on integers as well as on polynomials.
- */
-
-ExtendedEuclidean(_f,_g) <--
-[
- Local(r,s,t,i);
-
- /* Initialize the loop */
- r:={f,g};
- s:={1,0};
- t:={0,1};
- i:=1;
-
- Local(q,newr,news,newt);
- newr:=1;
- While(newr != 0)
- [
- newr:=Rem(r[i],r[i+1]);
- q :=Div(r[i],r[i+1]);
- news :=(s[i]-q*s[i+1]);
- newt :=(t[i]-q*t[i+1]);
- DestructiveAppend(r ,newr);
- DestructiveAppend(s,news);
- DestructiveAppend(t,newt);
- i++;
- ];
- {r[i],s[i],t[i]};
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/GcdReduce.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/GcdReduce.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/GcdReduce.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/GcdReduce.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,20 +0,0 @@
-%mathpiper,def="GcdReduce"
-
-/* Reduce rational function by dividing gcd away */
-GcdReduce(_f,_var)<--
-[
- Local(rat,gcd);
- rat:=RationalForm(f,var);
- gcd:=Gcd(rat[1],rat[2]);
-/* gcd:=gcd*Gcd(Content(rat[1]),Content(rat[2]));*/
-
- Local(numer,denom,lc);
- numer:=Div(rat[1],gcd);
- denom:=Div(rat[2],gcd);
- lc:=LeadingCoef(numer,var);
- numer:=numer/lc;
- denom:=denom/lc;
- Expand(numer)/Expand(denom);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PAdicExpandInternal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PAdicExpandInternal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PAdicExpandInternal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PAdicExpandInternal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-%mathpiper,def="PAdicExpandInternal"
-
-10 # PAdicExpandInternal(0,_y) <-- {};
-20 # PAdicExpandInternal(_x,_y) <--
-[
- Mod(x,y) : PAdicExpandInternal(Div(x,y),y);
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PAdicExpand.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PAdicExpand.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PAdicExpand.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PAdicExpand.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,88 +0,0 @@
-%mathpiper,def="PAdicExpand"
-
-/*
- TODO:
-
-
-
-
- - example:
- 20 # f(_x) <-- Sin(x);
- 10 # f(Eval(_x)) <-- Sin(Eval(x));
- HoldArgNr("f",1,1);
-
- Out( 0 ) = True;
- In( 1 ) = f(2+3)
- Out( 1 ) = Sin(2+3);
- In( 2 ) = f(Eval(2+3))
- Out( 2 ) = Sin(5);
-
- Alternative:
- f(x):=
- [
- UnHoldable(x);
- Sin(x);
- ];
-
- this is if you don't want to use patterns.
-
-
- Mini-module padic. This module creates a p-adic expansion of
- an expression:
-
- expression = a0 + a1*p + a2 * p^2 + ... etc.
-
- PAdicExpand and PAdicExpandInternal can be called with integer
- or univariate polynomial arguments.
- */
-
-
-Expand(x); /* TODO no idea why this is needed! Mod/Div/UniVariate thing :-( */
-
-10 # PAdicExpand(_x,_y) <--
-[
- Local(coefs);
- coefs:=PAdicExpandInternal(x,y);
- Subst(p,y)Add(coefs*(p^(0 .. Length(coefs))));
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="PAdicExpand",categories="User Functions;Number Theory"
-*CMD PAdicExpand --- p-adic expansion
-*STD
-*CALL
- PAdicExpand(n, p)
-
-*PARMS
-
-{n} -- number or polynomial to expand
-
-{p} -- base to expand in
-
-*DESC
-
-This command computes the $p$-adic expansion of $n$. In other words,
-$n$ is expanded in powers of $p$. The argument $n$ can be either
-an integer or a univariate polynomial. The base $p$ should be of the
-same type.
-
-*E.G.
-
- In> PrettyForm(PAdicExpand(1234, 10));
-
- 2 3
- 3 * 10 + 2 * 10 + 10 + 4
-
- Out> True;
- In> PrettyForm(PAdicExpand(x^3, x-1));
-
- 2 3
- 3 * ( x - 1 ) + 3 * ( x - 1 ) + ( x - 1 ) + 1
-
- Out> True;
-
-*SEE Mod, ContFrac, FromBase, ToBase
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PartFracExpand.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PartFracExpand.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/padic/PartFracExpand.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/padic/PartFracExpand.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="PartFracExpand",scope="private"
-
-/* Partial fraction expansion of g/f with Degree(g) MakeVector(a,3)
- Out> {a1,a2,a3};
-
-*SEE RandomIntegerVector, ZeroVector
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/patterns/pound_operator.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/patterns/pound_operator.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/patterns/pound_operator.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/patterns/pound_operator.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def=""
-
-//Not defined in the scripts.
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_2d/backends.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_2d/backends.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_2d/backends.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_2d/backends.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,166 +0,0 @@
-%mathpiper,def="Plot2DOutputs"
-
-//////////////////////////////////////////////////
-/// Backends for 2D plotting
-//////////////////////////////////////////////////
-
-
-/// List of all defined backends and their symbolic labels.
-/// Add any new backends here
-
-LocalSymbols(options)
-[
- options := {
- {"default", "data"},
- {"data", "Plot2DData"},
- {"java", "Plot2DJava"},
- {"geogebra", "Plot2DGeoGebra"},
- {"jfreechart", "Plot2DJFreeChart"},
-};
-
-
-Plot2DOutputs() := options;
-
-];
-
-/*
- How backends work:
- Plot2D'(values, optionsHash)
- optionsHash is a hash that contains all plotting options:
- ["xrange"] - a list of {x1, x2}, ["xname"] - name of the variable to plot, ["yname"] - array of string representations of the function(s), and perhaps other options relevant to the particular backend.
- {values} is a list of lists of pairs of the form {{{x1, y1}, {x2, y2}, ...}, {{x1, z1}, {x2, z2}, ...}, ...} corresponding to the functions y(x), z(x), ... to be plotted. The abscissa points x[i] are not the same for all functions.
- The backend should prepare the graph of the function(s). The "datafile" backend Plot2D'datafile(values, optionsHash) may be used to output all data to file(s), in which case the file name should be given by the value optionsHash["filename"]. Multiple files are created with names obtained by appending numbers to the filename.
- Note that the "data" backend does not do anything and simply returns the data.
- The backend Plot2D'datafile takes care not to write "Infinity" or "Undefined" data points (it just ignores them). Custom backends should either use Plot2D'datafile or take care of this themselves.
-*/
-
-/// trivial backend: return data list (do not confuse with Plot2D'get'data() defined in the main code which is the middle-level plotting routine)
-Plot2DData(values_IsList, _optionsHash) <-- values;
-
-/// The Java back-end generates a call-list that the Java graph plotter can handle
-Plot2DJava(values_IsList, _optionsHash) <--
-[
- Local(result,count);
- count := 0;
- result:="$plot2d:";
-
- result := result:" pensize 2.0 ";
- ForEach(function,values)
- [
- result := result:ColorForGraphNr(count);
- count++;
- result:=result:" lines2d ":String(Length(function));
-
- function:=Select(Lambda({item},item[2] != Undefined),function);
-
- ForEach(item,function)
- [
- result := result:" ":String(item[1]):" ":String(item[2]):" ";
- ];
- ];
- WriteString(result:"$");
- True;
-];
-
-10 # ColorForGraphNr(0) <-- " pencolor 64 64 128 ";
-10 # ColorForGraphNr(1) <-- " pencolor 128 64 64 ";
-10 # ColorForGraphNr(2) <-- " pencolor 64 128 64 ";
-20 # ColorForGraphNr(_count) <-- ColorForGraphNr(Mod(count,3));
-
-
-
-
-//GeoGebra backend.
-Plot2DGeogebra(values_IsList, _optionsHash) <--
-[
- Local(result,count);
- count := 0;
- result:="";
-
-
- ForEach(function,values)
- [
-
- function:=Select(Lambda({item},item[2] != Undefined),function);
-
- ForEach(item,function)
- [
- result := result:"(":String(item[1]):",":String(item[2]):")":Nl();
- ];
- ];
- WriteString(result);
- True;
-];
-
-
-
-
-//JFreeChart backend.
-Retract("Plot2DJFreeChart", *);
-Plot2DJFreeChart(values_IsList, _optionsHash) <--
-[
- Local(rangeList, domainList, function, allProcessedFunctionData, lineChartCallListForm);
-
-
-
- //Remove Plot2D's options so that they don't get passed through to LineChart();
- ForEach(name, {"xrange", "xname", "yname", "output", "precision", "points", "depth"})
- [
- AssocDelete(optionsHash, name);
- ];
-
-
-
- //Convert {x,y} pairs into {x,x,x,...} {y,y,y,...} form.
- allProcessedFunctionData := {};
-
- ForEach(function,values)
- [
- rangeList := {};
-
- domainList := {};
-
- function := Select(Lambda({item},item[2] != Undefined),function);
-
- ForEach(item,function)
- [
- rangeList := Append(rangeList, item[1]);
-
- domainList := Append(domainList, item[2]);
- ];
-
- allProcessedFunctionData := Append(allProcessedFunctionData, rangeList);
- allProcessedFunctionData := Append(allProcessedFunctionData, domainList);
-
- ];
-
-
-
- //Put LineChart() function call into list form so it can be manipulated.
- lineChartCallListForm := {LineChart, allProcessedFunctionData };
-
-
-
- //Add any options to the list.
- ForEach(key, AssocIndices(optionsHash))
- [
- lineChartCallListForm := Append(lineChartCallListForm, Apply("->", {key, optionsHash[key]}));
- ];
-
-
-
- //Call the LineChart() function.
- Eval(UnList(lineChartCallListForm));
-
-
-];
-
-
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_2d/plot2d.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_2d/plot2d.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_2d/plot2d.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_2d/plot2d.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,332 +0,0 @@
-%mathpiper,def="Plot2D"
-
-Retract("Plot2D", *);
-
-//////////////////////////////////////////////////
-/// Plot2D --- adaptive two-dimensional plotting
-//////////////////////////////////////////////////
-
-/// definitions of backends
-//Use("org/mathpiper/assembledscripts/plots.rep/backends_2d.mpi");
-
-/*
- Plot2D is an interface for various backends (Plot2D'...). It calls
-Plot2D'get'data to obtain the list of points and values, and then it calls
-Plot2D' on that data.
-
- Algorithm for Plot2D'get'data:
- 1) Split the given interval into Div(points+3, 4) subintervals, and split each subinterval into 4 parts.
- 2) For each of the parts: evaluate function values and call Plot2D'adaptive
- 3) concatenate resulting lists and return
-*/
-
-LocalSymbols(var, func, range, option, options'list, delta, options'hash, c, fc, all'values, dummy)
-[
-
-// declaration of Plot2D with variable number of arguments
-Function() Plot2D(func);
-Function() Plot2D(func, range);
-Function() Plot2D(func, range, options, ...);
-
-/// interface routines
-1 # Plot2D(_func) <-- ("Plot2D" @ {func, -5:5});
-2 # Plot2D(_func, _range) <-- ("Plot2D" @ {func, range, {}});
-3 # Plot2D(_func, _range, option_IsFunction) _ (Type(option) = "->" ) <-- ("Plot2D" @ {func, range, {option}});
-
-/// Plot a single function
-5 # Plot2D(_func, _range, options'list_IsList)_(Not IsList(func)) <-- ("Plot2D" @ {{func}, range, options'list});
-
-/// Top-level 2D plotting routine:
-/// plot several functions sharing the same xrange and other options
-4 # Plot2D(func'list_IsList, _range, options'list_IsList) <--
-[
- Local(var, func, delta, options'hash, c, fc, all'values, dummy);
- all'values := {};
- options'hash := "OptionsListToHash" @ {options'list};
-
-
- // this will be a string - name of independent variable
- options'hash["xname"] := "";
- // this will be a list of strings - printed forms of functions being plotted
- options'hash["yname"] := {};
- // parse range
- If (
- Type(range) = "->", // variable also specified -- ignore for now, store in options
- [
- // store alternative variable name
- options'hash["xname"] := String(range[1]);
- range := range[2];
- ]
- );
- If(
- Type(range) = ":", // simple range
- range := N(Eval({range[1], range[2]}))
- );
- // set default option values
- If(
- options'hash["points"] = Empty,
- options'hash["points"] := 23
- );
- If(
- options'hash["depth"] = Empty,
- options'hash["depth"] := 5
- );
- If(
- options'hash["precision"] = Empty,
- options'hash["precision"] := 0.0001
- );
- If(
- options'hash["output"] = Empty Or IsString(options'hash["output"]) And Plot2DOutputs()[options'hash["output"]] = Empty,
- options'hash["output"] := Plot2DOutputs()["default"]
- );
- // a "filename" parameter is required when using data file
- If(
- options'hash["output"] = "datafile" And options'hash["filename"] = Empty,
- options'hash["filename"] := "output.data"
- );
-
- // we will divide each subinterval in 4 parts, so divide number of points by 4 now
- options'hash["points"] := N(Eval(Div(options'hash["points"]+3, 4)));
-
- // in case it is not a simple number but an unevaluated expression
- options'hash["precision"] := N(Eval(options'hash["precision"]));
-
- // store range in options
- options'hash["xrange"] := {range[1], range[2]};
-
- // compute the separation between grid points
- delta := N(Eval( (range[2] - range[1]) / (options'hash["points"]) ));
-
- // check that the input parameters are valid (all numbers)
- Check(IsNumber(range[1]) And IsNumber(range[2]) And IsNumber(options'hash["points"]) And IsNumber(options'hash["precision"]),
- "Plot2D: Error: plotting range '"
- :(ToString()Write(range))
- :"' and/or the number of points '"
- :(ToString()Write(options'hash["points"]))
- :"' and/or precision '"
- :(ToString()Write(options'hash["precision"]))
- :"' is not numeric"
- );
- // loop over functions in the list
- ForEach(func, func'list)
- [
- // obtain name of variable
- var := VarList(func); // variable name in a one-element list
- Check(Length(var)<=1,
- "Plot2D: Error: expression is not a function of one variable: "
- :(ToString()Write(func))
- );
- // Allow plotting of constant functions
- If(Length(var)=0, var:={dummy});
- // store variable name if not already done so
- If(
- options'hash["xname"] = "",
- options'hash["xname"] := String(VarList(var)[1])
- );
- // store function name in options
- DestructiveAppend(options'hash["yname"], ToString()Write(func));
- // compute the first point to see if it's okay
- c := range[1];
- fc := N(Eval(Apply({var, func}, {c})));
- Check(IsNumber(fc) Or fc=Infinity Or fc= -Infinity Or fc=Undefined,
- "Plot2D: Error: cannot evaluate function '"
- :(ToString()Write(func))
- :"' at point '"
- :(ToString()Write(c))
- :"' to a number, instead got '"
- :(ToString()Write(fc))
- :"'"
- );
- // compute all other data points
- DestructiveAppend(all'values, Plot2D'get'data(func, var, c, fc, delta, options'hash) );
-
- If(InVerboseMode(), Echo({"Plot2D: using ", Length(all'values[Length(all'values)]), " points for function ", func}), True);
- ];
-
- // call the specified output backend
- Plot2DOutputs()[options'hash["output"]] @ {all'values, options'hash};
-];
-
-//HoldArg("Plot2D", range);
-//HoldArg("Plot2D", options);
-HoldArgNr("Plot2D", 2, 2);
-HoldArgNr("Plot2D", 3, 2);
-HoldArgNr("Plot2D", 3, 3);
-
-
-
-Retract("Plot2D'get'data", *);
-/// this is the middle-level plotting routine; it generates the initial
-/// grid, calls the adaptive routine, and gathers data points.
-/// func must be just one function (not a list)
-Plot2D'get'data(_func, _var, _x'init, _y'init, _delta'x, _options'hash) <--
-[
- Local(i, a, fa, b, fb, c, fc, result);
- // initialize list by first points (later will always use Rest() to exclude first points of subintervals)
- result := { {c,fc} := {x'init, y'init} };
- For(i:=0, i value)
- Plot2D(f(x), a:b, option -> value, ...)
- Plot2D(list, ...)
-
-*PARMS
-
-{f(x)} -- unevaluated expression containing one variables (function to be plotted)
-
-{list} -- list of functions to plot
-
-{a}, {b} -- numbers, plotting range in the $x$ coordinate
-
-{option} -- atom, option name
-
-{value} -- atom, number or string (value of option)
-
-*DESC
-The routine {Plot2D} performs adaptive plotting of one or several functions
-of one variable in the specified range.
-The result is presented as a line given by the equation $y=f(x)$.
-Several functions can be plotted at once.
-Various plotting options can be specified.
-Output can be directed to a plotting program (the default is to use
-{data}) to a list of values.
-
-The function parameter {f(x)} must evaluate to a MathPiper expression containing
-at most one variable. (The variable does not have to be called {x}.)
-Also, {N(f(x))} must evaluate to a real (not complex) numerical value when given a numerical value of the argument {x}.
-If the function {f(x)} does not satisfy these requirements, an error is raised.
-
-Several functions may be specified as a list and they do not have to depend on the same variable, for example, {{f(x), g(y)}}.
-The functions will be plotted on the same graph using the same coordinate ranges.
-
-If you have defined a function which accepts a number but does not
-accept an undefined variable, {Plot2D} will fail to plot it.
-Use {NFunction} to overcome this difficulty.
-
-Data files are created in a temporary directory {/tmp/plot.tmp/} unless otherwise requested.
-File names
-and other information is printed if {InVerboseMode()} returns {True} on using {V()}.
-
-The current algorithm uses Newton-Cotes quadratures and some heuristics for error estimation (see <*mathpiperdoc://Algo/3/1/*>).
-The initial grid of {points+1} points is refined between any grid points $a$, $b$ if the integral
-$Integrate(x,a,b)f(x)$ is not approximated to the given precision by
-the existing grid.
-
-Default plotting range is {-5:5}. Range can also be specified as {x= -5:5} (note the mandatory space separating "{=}" and "{-}");
-currently the variable name {x} is ignored in this case.
-
-Options are of the form {option -> value}. Currently supported option names
-are: "points", "precision", "depth", "output", "filename", "yrange". Option values
-are either numbers or special unevaluated atoms such as {data}.
-If you need to use the names of these atoms
-in your script, strings can be used. Several option/value pairs may be specified (the function {Plot2D} has a variable number of arguments).
-
-* {yrange}: the range of ordinates to use for plotting, e.g.
-{yrange=0:20}. If no range is specified, the default is usually to
-leave the choice to the plotting backend.
-* {points}: initial number of points (default 23) -- at least that
-many points will be plotted. The initial grid of this many points will be
-adaptively refined.
-* {precision}: graphing precision (default $10^(-6)$). This is interpreted as the relative precision of computing the integral of $f(x)-Min(f(x))$ using the grid points. For a smooth, non-oscillating function this value should be roughly 1/(number of screen pixels in the plot).
-* {depth}: max. refinement depth, logarithmic (default 5) -- means there will be at most $2^depth$ extra points per initial grid point.
-* {output}: name of the plotting backend. Supported names: {data} (default).
-The {data} backend will return the data as a list of pairs such as {{{x1,y1}, {x2,y2}, ...}}.
-* {filename}: specify name of the created data file. For example: {filename="data1.txt"}.
-The default is the name {"output.data"}.
-Note that if several functions are plotted, the data files will have a number appended to the given name, for example {data.txt1}, {data.txt2}.
-
-Other options may be supported in the future.
-
-The current implementation can deal with a singularity within the plotting range only if the function {f(x)} returns {Infinity}, {-Infinity} or
-{Undefined} at the singularity.
-If the function {f(x)} generates a numerical error and fails at a
-singularity, {Plot2D} will fail if one of the grid points falls on the
-singularity.
-(All grid points are generated by bisection so in principle the
-endpoints and the {points} parameter could be chosen to avoid numerical
-singularities.)
-
-*WIN32
-
-
-
-*SEE V, NFunction, Plot3DS
-%/mathpiper_docs
-
- %output,preserve="false"
-
-. %/output
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_3d/backends.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_3d/backends.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_3d/backends.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_3d/backends.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,31 +0,0 @@
-%mathpiper,def=""
-
-//////////////////////////////////////////////////
-/// Backends for 3D plotting
-//////////////////////////////////////////////////
-
-/// List of all defined backends and their symbolic labels.
-/// Add any new backends here
-Plot3DS'outputs() := {
- {"default", "data"},
- {"data", "Plot3DS'data"},
-};
-
-/*
- How backends work:
- Plot3DS'(values, options'hash)
- options'hash is a hash that contains all plotting options:
- ["xrange"] - a list of {x1, x2}, ["xname"] - name of the variable to plot, same for "yrange";
- ["zname"] - array of string representations of the function(s), and perhaps other options relevant to the particular backend.
- {values} is a list of lists of triples of the form {{{x1, y1, z1}, {x2, y2, z2}, ...}, {{x1, y1, t1}, {x2, y2, t2}, ...}, ...} corresponding to the functions z(x,y), t(x,y), ... to be plotted. The points x[i], y[i] are not necessarily the same for all functions.
- The backend should prepare the graph of the function(s). The "datafile" backend Plot3DS'datafile(values, options'hash) may be used to output all data to file(s), in which case the file name should be given by the value options'hash["filename"]. Multiple files are created with names obtained by appending numbers to the filename.
- Note that the "data" backend does not do anything and simply returns the data.
- The backend Plot3DS'datafile takes care not to write "Infinity" or "Undefined" data points (it just ignores them). Custom backends should either use Plot3DS'datafile to prepare a file, or take care of this themselves.
-*/
-
-/// trivial backend: return data list (do not confuse with Plot3DS'get'data() defined in the main code which is the middle-level plotting routine)
-Plot3DS'data(values_IsList, _options'hash) <-- values;
-
-
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_3d/plot3ds.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_3d/plot3ds.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/_3d/plot3ds.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/_3d/plot3ds.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,415 +0,0 @@
-%mathpiper,def="Plot3DS"
-
-//////////////////////////////////////////////////
-/// Plot3DS --- adaptive three-dimensional surface plotting
-//////////////////////////////////////////////////
-
-/// definitions of backends
-//Use("org/mathpiper/assembledscripts/plots.rep/backends_3d.mpi");
-
-/*
- Plot3DS is an interface for various backends (Plot3DS'...). It calls
-Plot3DS'get'data to obtain the list of points and values, and then it calls
-Plot3DS' on that data.
-
- Algorithm for Plot3DS'get'data:
- 1) Split the given square into Div(Sqrt(points)+1, 2) subsquares, and split each subsquare into 4 parts.
- 2) For each of the parts: evaluate function values and call Plot3DS'adaptive
- 3) concatenate resulting lists and return
-*/
-
- LocalSymbols(var, func, xrange, yrange, option, options'list, xdelta, ydelta, options'hash, cx, cy, fc, all'values, dummy)
-[
-
-// declaration of Plot3DS with variable number of arguments
-Function() Plot3DS(func);
-Function() Plot3DS(func, xrange, yrange);
-Function() Plot3DS(func, xrange, yrange, options, ...);
-
-
-/// interface routines
-1 # Plot3DS(_func) <-- ("Plot3DS" @ {func, -5:5, -5:5});
-2 # Plot3DS(_func, _xrange, _yrange) <-- ("Plot3DS" @ {func, xrange, yrange, {}});
-3 # Plot3DS(_func, _xrange, _yrange, option_IsFunction) _ (Type(option) = "->" ) <-- ("Plot3DS" @ {func, xrange, yrange, {option}});
-
-/// Plot a single function
-5 # Plot3DS(_func, _xrange, _yrange, options'list_IsList)_(Not IsList(func)) <-- ("Plot3DS" @ {{func}, xrange, yrange, options'list});
-
-/// Top-level 3D plotting routine:
-/// plot several functions sharing the same ranges and other options
-4 # Plot3DS(func'list_IsList, _xrange, _yrange, options'list_IsList) <--
-[
- Local(var, func, xdelta, ydelta, options'hash, cx, cy, fc, all'values, dummy);
- // this will be a list of all computed values
- all'values := {};
- options'hash := "OptionsListToHash" @ {options'list};
- // this will be a string - name of independent variable
- options'hash["xname"] := "";
- options'hash["yname"] := "";
- // this will be a list of strings - printed forms of functions being plotted
- options'hash["zname"] := {};
- // parse range
- If (
- Type(xrange) = "->", // variable also specified -- ignore for now, store in options
- [
- // store alternative variable name
- options'hash["xname"] := String(xrange[1]);
- xrange := xrange[2];
- ]
- );
- If (
- Type(yrange) = "->" , // variable also specified -- ignore for now, store in options
- [
- // store alternative variable name
- options'hash["yname"] := String(yrange[1]);
- yrange := yrange[2];
- ]
- );
- If(
- Type(xrange) = ":", // simple range
- xrange := N(Eval({xrange[1], xrange[2]}))
- );
- If(
- Type(yrange) = ":", // simple range
- yrange := N(Eval({yrange[1], yrange[2]}))
- );
- // set default option values
- If(
- options'hash["points"] = Empty,
- options'hash["points"] := 10 // default # of points along each axis
- );
- If(
- options'hash["xpoints"] = Empty,
- options'hash["xpoints"] := options'hash["points"]
- );
- If(
- options'hash["ypoints"] = Empty,
- options'hash["ypoints"] := options'hash["points"]
- );
-
- If(
- options'hash["depth"] = Empty,
- options'hash["depth"] := 2
- );
- If(
- options'hash["precision"] = Empty,
- options'hash["precision"] := 0.0001
- );
- If(
- options'hash["hidden"] = Empty Or Not IsBoolean(options'hash["hidden"]),
- options'hash["hidden"] := True
- );
- If(
- options'hash["output"] = Empty Or IsString(options'hash["output"]) And Plot3DS'outputs()[options'hash["output"]] = Empty,
- options'hash["output"] := Plot3DS'outputs()["default"]
- );
- // a "filename" parameter is required when using data file
- If(
- options'hash["output"] = "datafile" And options'hash["filename"] = Empty,
- options'hash["filename"] := "output.data"
- );
- options'hash["used depth"] := options'hash["depth"];
- // we will divide each subsquare in 4 parts, so divide number of points by 2 now
- options'hash["xpoints"] := N(Eval(Div(options'hash["xpoints"]+1, 2)));
- options'hash["ypoints"] := N(Eval(Div(options'hash["ypoints"]+1, 2)));
- // in case it is not a simple number but an unevaluated expression
- options'hash["precision"] := N(Eval(options'hash["precision"]));
- // store range in options
- options'hash["xrange"] := {xrange[1], xrange[2]};
- options'hash["yrange"] := {yrange[1], yrange[2]};
- // compute the separation between grid points
- xdelta := N(Eval( (xrange[2] - xrange[1]) / (options'hash["xpoints"]) ) );
- ydelta := N(Eval( (yrange[2] - yrange[1]) / (options'hash["ypoints"]) ) );
- // check that the input parameters are valid (all numbers)
- Check(IsNumericList({xrange[1], xrange[2], options'hash["xpoints"], options'hash["ypoints"], options'hash["precision"]}),
- "Plot3DS: Error: plotting ranges '"
- :(ToString()Write(xrange, yrange))
- :"' and/or the number of points '"
- :(ToString()Write(options'hash["xpoints"], options'hash["ypoints"]))
- :"' and/or precision '"
- :(ToString()Write(options'hash["precision"]))
- :"' is not numeric"
- );
- // loop over functions in the list
- ForEach(func, func'list)
- [
- // obtain name of variable
- var := VarList(func); // variable names in a list
- Check(Length(var)<=2,
- "Plot3DS: Error: expression is not a function of at most two variables: "
- :(ToString()Write(func))
- );
- // Allow plotting of constant functions
- If(Length(var)=0, var:={dummy, dummy});
- If(Length(var)=1, var:={var[1], dummy});
- // store variable name if not already done so
- If(
- options'hash["xname"] = "",
- options'hash["xname"] := String(var[1])
- );
- If(
- options'hash["yname"] = "",
- options'hash["yname"] := String(var[2])
- );
- // store function name in options
- DestructiveAppend(options'hash["zname"], ToString()Write(func));
- // compute the first point to see if it's okay
- cx := xrange[1]; cy := yrange[1];
- fc := N(Eval(Apply({var, func}, {cx, cy})));
- Check(IsNumber(fc) Or fc=Infinity Or fc= -Infinity Or fc=Undefined,
- "Plot3DS: Error: cannot evaluate function '"
- :(ToString()Write(func))
- :"' at point '"
- :(ToString()Write(cx, cy))
- :"' to a number, instead got '"
- :(ToString()Write(fc))
- :"'"
- );
- // compute all other data points
- DestructiveAppend(all'values, RemoveRepeated(HeapSort( Plot3DS'get'data(func, var, {cx, cy, fc}, {xdelta, ydelta}, options'hash), Hold({{x,y},x[1]value)
- Plot3DS(f(x,y), a:b, c:d, option->value, ...)
- Plot3DS(list, ...)
-
-*PARMS
-
-{f(x,y)} -- unevaluated expression containing two variables (function to be plotted)
-
-{list} -- list of functions to plot
-
-{a}, {b}, {c}, {d} -- numbers, plotting ranges in the $x$ and $y$ coordinates
-
-{option} -- atom, option name
-
-{value} -- atom, number or string (value of option)
-
-*DESC
-The routine {Plot3DS} performs adaptive plotting of a function
-of two variables in the specified ranges.
-The result is presented as a surface given by the equation $z=f(x,y)$.
-Several functions can be plotted at once, by giving a list of functions.
-Various plotting options can be specified.
-Output can be directed to a plotting program (the default is to use
-{data}), to a list of values.
-
-The function parameter {f(x,y)} must evaluate to a MathPiper expression containing
-at most two variables. (The variables do not have to be called {x} and {y}.)
-Also, {N(f(x,y))} must evaluate to a real (not complex) numerical value when given numerical values of the arguments {x}, {y}.
-If the function {f(x,y)} does not satisfy these requirements, an error is raised.
-
-Several functions may be specified as a list but they have to depend on the same symbolic variables, for example, {{f(x,y), g(y,x)}}, but not {{f(x,y), g(a,b)}}.
-The functions will be plotted on the same graph using the same coordinate ranges.
-
-If you have defined a function which accepts a number but does not
-accept an undefined variable, {Plot3DS} will fail to plot it.
-Use {NFunction} to overcome this difficulty.
-
-Data files are created in a temporary directory {/tmp/plot.tmp/} unless otherwise requested.
-File names
-and other information is printed if {InVerboseMode()} returns {True} on using {V()}.
-
-The current algorithm uses Newton-Cotes cubatures and some heuristics for error estimation (see <*mathpiperdoc://Algo/3/1/*>).
-The initial rectangular grid of {xpoints+1}*{ypoints+1} points is refined within any rectangle where the integral
-of $f(x,y)$ is not approximated to the given precision by
-the existing grid.
-
-Default plotting range is {-5:5} in both coordinates.
-A range can also be specified with a variable name, e.g. {x= -5:5} (note the mandatory space separating "{=}" and "{-}").
-The variable name {x} should be the same as that used in the function {f(x,y)}.
-If ranges are not given with variable names, the first variable encountered in the function {f(x,y)} is associated with the first of the two ranges.
-
-Options are of the form {option->value}. Currently supported option names
-are "points", "xpoints", "ypoints", "precision", "depth", "output", "filename", "xrange", "yrange", "zrange". Option values
-are either numbers or special unevaluated atoms such as {data}.
-If you need to use the names of these atoms
-in your script, strings can be used (e.g. {output="data"}). Several option/value pairs may be specified (the function {Plot3DS} has a variable number of arguments).
-
-* {xrange}, {yrange}: optionally override coordinate ranges. Note that {xrange} is always the first variable and {yrange} the second variable, regardless of the actual variable names.
-* {zrange}: the range of the $z$ axis to use for plotting, e.g.
-{zrange=0:20}. If no range is specified, the default is usually to
-leave the choice to the plotting backend. Automatic choice based on actual values may
-give visually inadequate plots if the function has a singularity.
-* {points}, {xpoints}, {ypoints}: initial number of points (default 10 each) -- at least that
-many points will be plotted in each coordinate.
-The initial grid of this many points will be
-adaptively refined.
-If {points} is specified, it serves as a default for both {xpoints} and {ypoints}; this value may be overridden by {xpoints} and {ypoints} values.
-* {precision}: graphing precision (default $0.01$). This is interpreted as the relative precision of computing the integral of $f(x,y)-Min(f(x,y))$ using the grid points. For a smooth, non-oscillating function this value should be roughly 1/(number of screen pixels in the plot).
-* {depth}: max. refinement depth, logarithmic (default 3) -- means there will be at most $2^depth$ extra points per initial grid point (in each coordinate).
-* {output}: name of the plotting backend. Supported names: {data} (default).
-The {data} backend will return the data as a list of triples such as {{{x1, y1, z1}, {x2, y2, z2}, ...}}.
-
-Other options may be supported in the future.
-
-The current implementation can deal with a singularity within the plotting range only if the function {f(x,y)} returns {Infinity}, {-Infinity} or
-{Undefined} at the singularity.
-If the function {f(x,y)} generates a numerical error and fails at a
-singularity, {Plot3DS} will fail only if one of the grid points falls on the
-singularity.
-(All grid points are generated by bisection so in principle the
-endpoints and the {xpoints}, {ypoints} parameters could be chosen to avoid numerical
-singularities.)
-
-The {filename} option is optional if using graphical backends, but can be used to specify the location of the created data file.
-
-*WIN32
-
-Same limitations as {Plot2D}.
-
-*E.G. notest
- In> Plot3DS(a*b^2)
- Out> True;
- In> V(Plot3DS(Sin(x)*Cos(y),x->0:20, y->0:20,depth->3))
- CachedConstant: Info: constant Pi is being
- recalculated at precision 10
- CachedConstant: Info: constant Pi is being
- recalculated at precision 11
- Plot3DS: using 1699 points for function Sin(x)*Cos(y)
- Plot3DS: max. used 8 subdivisions for Sin(x)*Cos(y)
- Plot3DS'datafile: created file '/tmp/plot.tmp/data1'
- Out> True;
-
-
-*SEE V, NFunction, Plot2D
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/OptionsListToHash.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/OptionsListToHash.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/OptionsListToHash.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/OptionsListToHash.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="OptionsListToHash"
-
-/// utility function: convert options lists of the form
-/// "{key=value, key=value}" into a hash of the same form.
-/// The argument list is kept unevaluated using "HoldArgNr()".
-/// Note that symbolic values of type atom are automatically converted to strings, e.g. ListToHash({a -> b}) returns {{"a", "b"}}
-OptionsListToHash(list) :=
-[
- Local(item, result);
- result := {};
- ForEach(item, list)
- If(
- IsFunction(item) And (Type(item) = "->" ) And IsAtom(item[1]),
- result[String(item[1])] := If(
- IsAtom(item[2]) And Not IsNumber(item[2]) And Not IsString(item[2]),
- String(item[2]),
- item[2]
- ),
- Echo({"OptionsListToHash: Error: item ", item, " is not of the format a -> b."})
- );
-
- result;
-];
-
-HoldArgNr("OptionsListToHash", 1, 1);
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/RemoveRepeated.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/RemoveRepeated.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/RemoveRepeated.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/RemoveRepeated.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,17 +0,0 @@
-%mathpiper,def="RemoveRepeated"
-
-10 # RemoveRepeated({}) <-- {};
-10 # RemoveRepeated({_x}) <-- {x};
-20 # RemoveRepeated(list_IsList) <-- [
- Local(i, done);
- done := False;
- For(i:=0, Not done, i++)
- [
- While(iy And yz
- )
-, 0, 1);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/WriteDataItem.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/WriteDataItem.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/plots/WriteDataItem.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/plots/WriteDataItem.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,19 +0,0 @@
-%mathpiper,def="WriteDataItem"
-
-/// service function. WriteDataItem({1,2,3}, {}) will output "1 2 3" on a separate line.
-/// Writes data points to the current output stream, omits non-numeric values.
-WriteDataItem(tuple_IsList, _options'hash) <--
-[
- Local(item);
- If( // do not write anything if one of the items is not a number
- IsNumericList(tuple),
- ForEach(item,tuple)
- [
- Write(item);
- Space();
- ]
- );
- NewLine();
-];
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/AllSatisfy.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/AllSatisfy.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/AllSatisfy.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/AllSatisfy.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="AllSatisfy"
-
-10 # AllSatisfy(pred_IsString,lst_IsList) <-- Apply("And",(MapSingle(pred,lst)));
-
-20 # AllSatisfy(_pred,_lst) <-- False;
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-%mathpiper_docs,name="AllSatisfy",categories="User Functions;Predicates"
-
-
-*CMD AllSatisfy --- Check if all elements of list {lst} satisfy predicate {pred}
-
-*STD
-*CALL
- AllSatisfy(pred,lst)
-
-*PARMS
-
-{pred} -- the name of the predicate (as string, with quotes) to be tested
-
-{lst} -- a list
-
-
-*DESC
-
-The command {AllSatisfy} returns {True} if every element of the list {lst} satisfies the predicate {pred}.
-It returns {False} otherwise.
-It also returns {False} if {lst} is not a list, or if {pred} is not a predicate.
-
-*E.G.
-
- In> AllSatisfy("IsInteger",{1,0,-5})
- Result> True
- In> AllSatisfy("IsPositiveInteger",{1,0,-5})
- Result> False
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/FloatIsInt.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/FloatIsInt.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/FloatIsInt.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/FloatIsInt.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,23 +0,0 @@
-%mathpiper,def="FloatIsInt"
-
-/// TODO FIXME document this: FloatIsInt returns True if the argument is integer after removing potential trailing
-/// zeroes after the decimal point
-// but in fact this should be a call to BigNumber::IsIntValue()
-FloatIsInt(_x) <--
- [
- x:=N(Eval(x));
- Local(prec,result,n);
- Set(prec,BuiltinPrecisionGet());
- If(IsZero(x),Set(n,2),
- If(x>0,
- Set(n,2+FloorN(N(FastLog(x)/FastLog(10)))),
- Set(n,2+FloorN(N(FastLog(-x)/FastLog(10))))
- ));
- BuiltinPrecisionSet(n+prec);
- Set(result,IsZero(RoundTo(x-Floor(x),prec)) Or IsZero(RoundTo(x-Ceil(x),prec)));
- BuiltinPrecisionSet(prec);
- result;
- ];
-//
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExprArith.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExprArith.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExprArith.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExprArith.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="HasExprArith"
-
-/// Analyse arithmetic expressions
-
-HasExprArith(expr, atom) := HasExprSome(expr, atom, {Atom("+"), Atom("-"), *, /});
-
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasExprArith",categories="User Functions;Predicates"
-*CMD HasExprArith --- check for expression containing a subexpression
-*STD
-*CALL
- HasExprArith(expr, x)
-
-*PARMS
-
-{expr} -- an expression
-
-{x} -- a subexpression to be found
-
-*DESC
-
-{HasExprArith} is defined through {HasExprSome} to look only at arithmetic operations {+}, {-}, {*}, {/}.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasExprArith(x+y*Cos(Ln(x)/x), z)
- Out> False;
-
-*SEE HasExpr, HasExprSome, FuncList, VarList, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExpr.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExpr.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExpr.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExpr.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,51 +0,0 @@
-%mathpiper,def="HasExpr"
-
-/// HasExpr --- test for an expression containing a subexpression
-/// for checking dependence on variables, this may be faster than using VarList or IsFreeOf and this also can be used on non-variables, e.g. strings or numbers or other atoms or even on non-atoms
-// an expression contains itself -- check early
-10 # HasExpr(_expr, _atom) _ Equals(expr, atom) <-- True;
-// an atom contains itself
-15 # HasExpr(expr_IsAtom, _atom) <-- Equals(expr, atom);
-// a list contains an atom if one element contains it
-// we test for lists now because lists are also functions
-// first take care of the empty list:
-19 # HasExpr({}, _atom) <-- False;
-20 # HasExpr(expr_IsList, _atom) <-- HasExpr(First(expr), atom) Or HasExpr(Rest(expr), atom);
-// a function contains an atom if one of its arguments contains it
-30 # HasExpr(expr_IsFunction, _atom) <-- HasExpr(Rest(Listify(expr)), atom);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasExpr",categories="User Functions;Predicates"
-*CMD HasExpr --- check for expression containing a subexpression
-*STD
-*CALL
- HasExpr(expr, x)
-
-*PARMS
-
-{expr} -- an expression
-
-{x} -- a subexpression to be found
-
-
-
-*DESC
-
-The command {HasExpr} returns {True} if the expression {expr} contains a literal subexpression {x}. The expression is recursively traversed.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasExpr(x+y*Cos(Ln(z)/z), z)
- Out> True;
- In> HasExpr(x+y*Cos(Ln(z)/z), Ln(z))
- Out> True;
- In> HasExpr(x+y*Cos(Ln(z)/z), z/Ln(z))
- Out> False;
-
-*SEE HasExprArith, HasExprSome, FuncList, VarList, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExprSome.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExprSome.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasExprSome.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasExprSome.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,50 +0,0 @@
-%mathpiper,def="HasExprSome"
-
-/// Same except only look at function arguments for functions in a given list
-HasExprSome(_expr, _atom, _look'list) _ Equals(expr, atom) <-- True;
-// an atom contains itself
-15 # HasExprSome(expr_IsAtom, _atom, _look'list) <-- Equals(expr, atom);
-// a list contains an atom if one element contains it
-// we test for lists now because lists are also functions
-// first take care of the empty list:
-19 # HasExprSome({}, _atom, _look'list) <-- False;
-20 # HasExprSome(expr_IsList, _atom, _look'list) <-- HasExprSome(First(expr), atom, look'list) Or HasExprSome(Rest(expr), atom, look'list);
-// a function contains an atom if one of its arguments contains it
-// first deal with functions that do not belong to the list: return False since we have already checked it at #15
-25 # HasExprSome(expr_IsFunction, _atom, _look'list)_(Not Contains(look'list, Atom(Type(expr)))) <-- False;
-// a function contains an atom if one of its arguments contains it
-30 # HasExprSome(expr_IsFunction, _atom, _look'list) <-- HasExprSome(Rest(Listify(expr)), atom, look'list);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasExprSome",categories="User Functions;Predicates"
-*CMD HasExprSome --- check for expression containing a subexpression
-*STD
-*CALL
- HasExprSome(expr, x, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{x} -- a subexpression to be found
-
-{list} -- list of function atoms to be considered "transparent"
-
-*DESC
-
-The command {HasExprSome} does the same as {HasExpr}, except it only looks at arguments of a given {list} of functions. All other functions become "opaque" (as if they do not contain anything).
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasExprSome({a+b*2,c/d},c/d,{List})
- Out> True;
- In> HasExprSome({a+b*2,c/d},c,{List})
- Out> False;
-
-*SEE HasExpr, HasExprArith, FuncList, VarList, HasFunc
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFuncArith.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFuncArith.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFuncArith.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFuncArith.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="HasFuncArith"
-
-/// Analyse arithmetic expressions
-
-HasFuncArith(expr, atom) := HasFuncSome(expr, atom, {Atom("+"), Atom("-"), *, /});
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasFuncArith",categories="User Functions;Predicates"
-*CMD HasFuncArith --- check for expression containing a function
-*STD
-*CALL
- HasFuncArith(expr, func)
-
-*PARMS
-
-{expr} -- an expression
-
-{func} -- a function atom to be found
-
-*DESC
-
-{HasFuncArith} is defined through {HasFuncSome} to look only at arithmetic operations {+}, {-}, {*}, {/}.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasFuncArith(x+y*Cos(Ln(x)/x), Cos)
- Out> True;
- In> HasFuncArith(x+y*Cos(Ln(x)/x), Ln)
- Out> False;
-
-*SEE HasFunc, HasFuncSome, FuncList, VarList, HasExpr
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFunc.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFunc.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFunc.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFunc.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="HasFunc"
-
-/// HasFunc --- test for an expression containing a function
-/// function name given as string.
-10 # HasFunc(_expr, string_IsString) <-- HasFunc(expr, Atom(string));
-/// function given as atom.
-// atom contains no functions
-10 # HasFunc(expr_IsAtom, atom_IsAtom) <-- False;
-// a list contains the function List so we test it together with functions
-// a function contains itself, or maybe an argument contains it
-20 # HasFunc(expr_IsFunction, atom_IsAtom) <-- Equals(First(Listify(expr)), atom) Or ListHasFunc(Rest(Listify(expr)), atom);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasFunc",categories="User Functions;Predicates"
-*CMD HasFunc --- check for expression containing a function
-*STD
-*CALL
- HasFunc(expr, func)
-
-*PARMS
-
-{expr} -- an expression
-
-{func} -- a function atom to be found
-
-*DESC
-
-The command {HasFunc} returns {True} if the expression {expr} contains a function {func}. The expression is recursively traversed.
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasFunc(x+y*Cos(Ln(z)/z), Ln)
- Out> True;
- In> HasFunc(x+y*Cos(Ln(z)/z), Sin)
- Out> False;
-
-*SEE HasFuncArith, HasFuncSome, FuncList, VarList, HasExpr
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFuncSome.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFuncSome.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/HasFuncSome.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/HasFuncSome.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,48 +0,0 @@
-%mathpiper,def="HasFuncSome"
-
-/// function name given as string.
-10 # HasFuncSome(_expr, string_IsString, _look'list) <-- HasFuncSome(expr, Atom(string), look'list);
-/// function given as atom.
-// atom contains no functions
-10 # HasFuncSome(expr_IsAtom, atom_IsAtom, _look'list) <-- False;
-// a list contains the function List so we test it together with functions
-// a function contains itself, or maybe an argument contains it
-
-// first deal with functions that do not belong to the list: return top level function
-15 # HasFuncSome(expr_IsFunction, atom_IsAtom, _look'list)_(Not Contains(look'list, Atom(Type(expr)))) <-- Equals(First(Listify(expr)), atom);
-// function belongs to the list - check its arguments
-20 # HasFuncSome(expr_IsFunction, atom_IsAtom, _look'list) <-- Equals(First(Listify(expr)), atom) Or ListHasFuncSome(Rest(Listify(expr)), atom, look'list);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="HasFuncSome",categories="User Functions;Predicates"
-*CMD HasFuncSome --- check for expression containing a function
-*STD
-*CALL
- HasFuncSome(expr, func, list)
-
-*PARMS
-
-{expr} -- an expression
-
-{func} -- a function atom to be found
-
-{list} -- list of function atoms to be considered "transparent"
-
-*DESC
-
-The command {HasFuncSome} does the same thing as {HasFunc}, except it only looks at arguments of a given {list} of functions. Arguments of all other functions become "opaque" (as if they do not contain anything).
-
-Note that since the operators "{+}" and "{-}" are prefix as well as infix operators, it is currently required to use {Atom("+")} to obtain the unevaluated atom "{+}".
-
-*E.G.
-
- In> HasFuncSome({a+b*2,c/d},/,{List})
- Out> True;
- In> HasFuncSome({a+b*2,c/d},*,{List})
- Out> False;
-
-*SEE HasFunc, HasFuncArith, FuncList, VarList, HasExpr
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsBoolean.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsBoolean.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsBoolean.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsBoolean.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,37 +0,0 @@
-%mathpiper,def="IsBoolean"
-
-Function ("IsBoolean", {x})
- (x=True) Or (x=False) Or IsFunction(x) And Contains({"=", ">", "<", ">=", "<=", "!=", "And", "Not", "Or"}, Type(x));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsBoolean",categories="User Functions;Predicates"
-*CMD IsBoolean --- test for a Boolean value
-*STD
-*CALL
- IsBoolean(expression)
-
-*PARMS
-
-{expression} -- an expression
-
-*DESC
-
-IsBoolean returns True if the argument is of a boolean type.
-This means it has to be either True, False, or an expression involving
-functions that return a boolean result, e.g.
-{=}, {>}, {<}, {>=}, {<=}, {!=}, {And}, {Not}, {Or}.
-
-*E.G.
-
- In> IsBoolean(a)
- Out> False;
- In> IsBoolean(True)
- Out> True;
- In> IsBoolean(a And b)
- Out> True;
-
-*SEE True, False
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsBoolType.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsBoolType.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsBoolType.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsBoolType.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-%mathpiper,def="IsBoolType"
-
-0 # IsBoolType(True) <-- True;
-0 # IsBoolType(False) <-- True;
-1 # IsBoolType(_anythingelse) <-- False;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsConstant.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsConstant.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsConstant.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsConstant.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="IsConstant"
-
-IsConstant(_n) <-- (VarList(n) = {});
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsConstant",categories="User Functions;Predicates"
-*CMD IsConstant --- test for a constant
-*STD
-*CALL
- IsConstant(expr)
-
-*PARMS
-
-{expr} -- some expression
-
-*DESC
-
-{IsConstant} returns {True} if the
-expression is some constant or a function with constant arguments. It
-does this by checking that no variables are referenced in the
-expression. {Pi} is considered a constant.
-
-*E.G.
-
- In> IsConstant(Cos(x))
- Out> False;
- In> IsConstant(Cos(2))
- Out> True;
- In> IsConstant(Cos(2+x))
- Out> False;
-
-*SEE IsNumber, IsInteger, VarList
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsDiagonal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsDiagonal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsDiagonal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsDiagonal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,46 +0,0 @@
-%mathpiper,def="IsDiagonal"
-
-IsDiagonal(A_IsMatrix) <--
-[
- Local(i,j,m,n,result);
- m:=Length(A);
- n:=Length(A[1]);
- i:=2;
- result:=(m=n);
- While(i<=m And result)
- [
- j:=1;
- While(j<=n And result)
- [
- result:= (i=j Or A[i][j] = 0);
- j++;
- ];
- i++;
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsDiagonal",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsDiagonal --- test for a diagonal matrix
-*STD
-*CALL
- IsDiagonal(A)
-
-*PARMS
-
-{A} -- a matrix
-
-*DESC
-
-{IsDiagonal(A)} returns {True} if {A} is a diagonal square matrix and {False} otherwise.
-
-*E.G.
- In> IsDiagonal(Identity(5))
- Out> True;
- In> IsDiagonal(HilbertMatrix(5))
- Out> False;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEquation.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEquation.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEquation.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEquation.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,42 +0,0 @@
-%mathpiper,def="IsEquation"
-
-Retract("IsEquation",*);
-
-10 # IsEquation(expr_IsAtom) <-- False;
-
-12 # IsEquation(_expr) <-- Listify(expr)[1] = == ;
-
-%/mathpiper
-
-
-
-
-%mathpiper_docs,name="IsEquation",categories="User Functions;Predicates"
-
-*CMD IsEquation --- Return true if {expr} is an Equation, False otherwise
-
-*STD
-*CALL
- IsEquation(expr)
-
-*PARMS
-
-{expr} -- mathematical expression
-
-*DESC
-
-This function returns {True} if MathPiper can determine that the expression is an equation.
-Otherwise, {False}.
-Equations are defined by the property that they are of the form {a==b}.
-
-*E.G.
-
-In> IsEquation(x^2==4)
-
-Result: True
-
-In> IsEquation(x^2-4)
-
-Result: False
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEvenFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEvenFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEvenFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEvenFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,56 +0,0 @@
-%mathpiper,def="IsEvenFunction"
-
-IsEvenFunction(f,x):= (f = Eval(Subst(x,-x)f));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsEvenFunction",categories="User Functions;Predicates"
-*CMD IsEvenFunction --- Return true if function is an even function (False otherwise)
-
-*STD
-*CALL
- IsEvenFunction(expression,variable)
-
-*PARMS
-
-{expression} -- mathematical expression
-{variable} -- variable
-
-*DESC
-
-This function returns True if MathPiper can determine that the
-function is even. Even functions are
-defined to be functions that have the property:
-
-$$ f(x) = f(-x) $$
-
-{Cos(x)} is an example of an even function.
-
-As a side note, one can decompose a function into an
-even and an odd part:
-
-$$ f(x) = f_even(x) + f_odd(x) $$
-
-Where
-
-$$ f_even(x) = (f(x)+f(-x))/2 $$
-
-and
-
-$$ f_odd(x) = (f(x)-f(-x))/2 $$
-
-*E.G.
-
- In> IsEvenFunction(Cos(b*x),x)
- Out> True
- In> IsEvenFunction(Sin(b*x),x)
- Out> False
- In> IsEvenFunction(1/x^2,x)
- Out> True
- In> IsEvenFunction(1/x,x)
- Out> False
-
-*SEE IsOddFunction, Sin, Cos
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEven.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEven.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsEven.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsEven.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsEven"
-
-IsEven(n) := IsInteger(n) And ( BitAnd(n,1) = 0 );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsEven",categories="User Functions;Predicates"
-*CMD IsEven --- test for an even integer
-*STD
-*CALL
- IsEven(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This function tests whether the integer "n" is even. An integer is
-even if it is divisible by two. Hence the even numbers are 0, 2, 4, 6,
-8, 10, etc., and -2, -4, -6, -8, -10, etc.
-
-*E.G.
-
- In> IsEven(4);
- Out> True;
- In> IsEven(-1);
- Out> False;
-
-*SEE IsOdd, IsInteger
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsHermitian.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsHermitian.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsHermitian.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsHermitian.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsHermitian"
-
-IsHermitian(A_IsMatrix) <-- (Conjugate(Transpose(A))=A);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsHermitian",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsHermitian --- test for a Hermitian matrix
-*STD
-*CALL
- IsHermitian(A)
-
-*PARMS
-
-{A} -- a square matrix
-
-*DESC
-
-IsHermitian(A) returns {True} if {A} is Hermitian and {False}
-otherwise. $A$ is a Hermitian matrix iff Conjugate( Transpose $A$ )=$A$.
-If $A$ is a real matrix, it must be symmetric to be Hermitian.
-
-*E.G.
-
- In> IsHermitian({{0,I},{-I,0}})
- Out> True;
- In> IsHermitian({{0,I},{2,0}})
- Out> False;
-
-*SEE IsUnitary
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsIdempotent.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsIdempotent.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsIdempotent.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsIdempotent.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,31 +0,0 @@
-%mathpiper,def="IsIdempotent"
-
-IsIdempotent(A_IsMatrix) <-- (A^2 = A);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsIdempotent",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsIdempotent --- test for an idempotent matrix
-*STD
-*CALL
- IsIdempotent(A)
-
-*PARMS
-
-{A} -- a square matrix
-
-*DESC
-
-{IsIdempotent(A)} returns {True} if {A} is idempotent and {False} otherwise.
-$A$ is idempotent iff $A^2=A$. Note that this also implies that $A$ raised
-to any power is also equal to $A$.
-
-*E.G.
-
- In> IsIdempotent(ZeroMatrix(10,10));
- Out> True;
- In> IsIdempotent(Identity(20))
- Out> True;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsInfinity.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsInfinity.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsInfinity.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsInfinity.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="IsInfinity"
-
-10 # IsInfinity(Infinity) <-- True;
-10 # IsInfinity(-(_x)) <-- IsInfinity(x);
-
-// This is just one example, we probably need to extend this further to include all
-// cases for f*Infinity where f can be guaranteed to not be zero
-11 # IsInfinity(Sign(_x)*y_IsInfinity) <-- True;
-
-60000 # IsInfinity(_x) <-- False;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsInfinity",categories="User Functions;Predicates"
-*CMD IsInfinity --- test for an infinity
-*STD
-*CALL
- IsInfinity(expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-*DESC
-
-This function tests whether {expr} is an infinity. This is only the
-case if {expr} is either {Infinity} or {-Infinity}.
-
-*E.G.
-
- In> IsInfinity(10^1000);
- Out> False;
- In> IsInfinity(-Infinity);
- Out> True;
-
-*SEE Integer
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsLowerTriangular.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsLowerTriangular.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsLowerTriangular.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsLowerTriangular.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,36 +0,0 @@
-%mathpiper,def="IsLowerTriangular"
-
-IsLowerTriangular(A_IsMatrix) <-- (IsUpperTriangular(Transpose(A)));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsLowerTriangular",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsLowerTriangular --- test for a lower triangular matrix
-*STD
-*CALL
- IsLowerTriangular(A)
-
-*PARMS
-
-{A} -- a matrix
-
-*DESC
-
-A lower triangular matrix is a square matrix which has all zero entries below the diagonal.
-
-{IsLowerTriangular(A)} returns {True} if {A} is a lower triangular matrix and {False} otherwise.
-
-*E.G.
- In> IsLowerTriangular(Identity(5))
- Out> True;
- In> IsLowerTriangular({{1,2},{0,1}})
- Out> False;
-
-A non-square matrix cannot be triangular:
- In> IsLowerTriangular({{1,2,3},{0,1,2}})
- Out> False;
-
-*SEE IsUpperTriangle, IsDiagonal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsNegativeInteger"
-
-IsNegativeInteger(x):= IsInteger(x) And x < 0;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNegativeInteger",categories="User Functions;Predicates"
-*CMD IsNegativeInteger --- test for a negative integer
-*STD
-*CALL
- IsNegativeInteger(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This function tests whether the integer {n} is (strictly)
-negative. The negative integers are -1, -2, -3, -4, -5, etc. If
-{n} is not a integer, the function returns {False}.
-
-*E.G.
-
- In> IsNegativeInteger(31);
- Out> False;
- In> IsNegativeInteger(-2);
- Out> True;
-
-*SEE IsPositiveInteger, IsNonZeroInteger, IsNegativeNumber
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="IsNegativeNumber"
-
-IsNegativeNumber(x):= IsNumber(x) And x < 0;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNegativeNumber",categories="User Functions;Predicates"
-*CMD IsNegativeNumber --- test for a negative number
-*STD
-*CALL
- IsNegativeNumber(n)
-
-*PARMS
-
-{n} -- number to test
-
-*DESC
-
-{IsNegativeNumber(n)} evaluates to {True} if $n$ is (strictly) negative, i.e.
-if $n<0$. If {n} is not a number, the functions return {False}.
-
-*E.G.
-
- In> IsNegativeNumber(6);
- Out> False;
- In> IsNegativeNumber(-2.5);
- Out> True;
-
-*SEE IsNumber, IsPositiveNumber, IsNotZero, IsNegativeInteger, IsNegativeReal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeReal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeReal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNegativeReal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNegativeReal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="IsNegativeReal"
-
-/* See if a number, when evaluated, would be a positive real value */
-
-IsNegativeReal(_r) <--
-[
- r:=N(Eval(r));
- (IsNumber(r) And r <= 0);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNegativeReal",categories="User Functions;Predicates"
-*CMD IsNegativeReal --- test for a numerically negative value
-*STD
-*CALL
- IsNegativeReal(expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-*DESC
-
-This function tries to approximate {expr} numerically. It returns {True} if this approximation is negative. In case no
-approximation can be found, the function returns {False}. Note that round-off errors may cause incorrect
-results.
-
-*E.G.
-
- In> IsNegativeReal(Sin(1)-3/4);
- Out> False;
- In> IsNegativeReal(Sin(1)-6/7);
- Out> True;
- In> IsNegativeReal(Exp(x));
- Out> False;
-
-The last result is because {Exp(x)} cannot be
-numerically approximated if {x} is not known. Hence
-MathPiper can not determine the sign of this expression.
-
-*SEE IsPositiveReal, IsNegativeNumber, N
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonNegativeInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonNegativeInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonNegativeInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonNegativeInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsNonNegativeInteger"
-
-IsNonNegativeInteger(x):= IsInteger(x) And x >= 0;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonNegativeNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonNegativeNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonNegativeNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonNegativeNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsNonNegativeNumber"
-
-IsNonNegativeNumber(x):= IsNumber(x) And x >= 0;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonZeroInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonZeroInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNonZeroInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNonZeroInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="IsNonZeroInteger"
-
-IsNonZeroInteger(x) := (IsInteger(x) And x != 0);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNonZeroInteger",categories="User Functions;Predicates"
-*CMD IsNonZeroInteger --- test for a nonzero integer
-*STD
-*CALL
- IsNonZeroInteger(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This function tests whether the integer {n} is not zero. If {n} is
-not an integer, the result is {False}.
-
-*E.G.
-
- In> IsNonZeroInteger(0)
- Out> False;
- In> IsNonZeroInteger(-2)
- Out> True;
-
-*SEE IsPositiveInteger, IsNegativeInteger, IsNotZero
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNotZero.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNotZero.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNotZero.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNotZero.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,39 +0,0 @@
-%mathpiper,def="IsNotZero"
-
-/*
-10 # IsNotZero(x_IsNumber) <-- ( RoundTo(x,BuiltinPrecisionGet()) != 0);
-*/
-
-
-10 # IsNotZero(x_IsNumber) <-- ( AbsN(x) >= PowerN(10, -BuiltinPrecisionGet()));
-10 # IsNotZero(x_IsInfinity) <-- True;
-60000 # IsNotZero(_x) <-- False;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNotZero",categories="User Functions;Predicates"
-*CMD IsNotZero --- test for a nonzero number
-*STD
-*CALL
- IsNotZero(n)
-
-*PARMS
-
-{n} -- number to test
-
-*DESC
-
-{IsNotZero(n)} evaluates to {True} if {n} is not zero. In case {n} is not a
-number, the function returns {False}.
-
-*E.G.
-
- In> IsNotZero(3.25);
- Out> True;
- In> IsNotZero(0);
- Out> False;
-
-*SEE IsNumber, IsPositiveNumber, IsNegativeNumber, IsNonZeroInteger
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNumericList.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNumericList.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsNumericList.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsNumericList.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,25 +0,0 @@
-%mathpiper,def="IsNumericList"
-
-// check that all items in the list are numbers
-IsNumericList(_arg'list) <-- IsList(arg'list) And
- ("And" @ (MapSingle(Hold({{x},IsNumber(N(Eval(x)))}), arg'list)));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsNumericList",categories="User Functions;Predicates"
-*CMD IsNumericList --- test for a list of numbers
-*STD
-*CALL
- IsNumericList({list})
-
-*PARMS
-
-{{list}} -- a list
-
-*DESC
-Returns {True} when called on a list of numbers or expressions that evaluate to numbers using {N()}. Returns {False} otherwise.
-
-*SEE N, IsNumber
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOddFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOddFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOddFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOddFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper,def="IsOddFunction"
-
-IsOddFunction(f,x):= (f = Eval(-Subst(x,-x)f));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsOddFunction",categories="User Functions;Predicates"
-*CMD IsOddFunction --- Return true if function is an odd function (False otherwise)
-
-*STD
-*CALL
- IsOddFunction(expression,variable)
-
-*PARMS
-
-{expression} -- mathematical expression
-{variable} -- variable
-
-*DESC
-
-This function returns True if MathPiper can determine that the
-function is odd. Odd functions have the property:
-
-$$ f(x) = -f(-x) $$
-
-{Sin(x)} is an example of an odd function.
-
-As a side note, one can decompose a function into an
-even and an odd part:
-
-$$ f(x) = f_even(x) + f_odd(x) $$
-
-Where
-
-$$ f_even(x) = (f(x)+f(-x))/2 $$
-
-and
-
-$$ f_odd(x) = (f(x)-f(-x))/2 $$
-
-*E.G.
-
- In> IsOddFunction(Cos(b*x),x)
- Out> False
- In> IsOddFunction(Sin(b*x),x)
- Out> True
- In> IsOddFunction(1/x,x)
- Out> True
- In> IsOddFunction(1/x^2,x)
- Out> False
-
-*SEE IsEvenFunction, Sin, Cos
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOdd.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOdd.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOdd.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOdd.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsOdd"
-
-IsOdd(n) := IsInteger(n) And ( BitAnd(n,1) = 1 );
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsOdd",categories="User Functions;Predicates"
-*CMD IsOdd --- test for an odd integer
-*STD
-*CALL
- IsOdd(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This function tests whether the integer "n" is odd. An integer is
-odd if it is not divisible by two. Hence the odd numbers are 1, 3, 5,
-7, 9, etc., and -1, -3, -5, -7, -9, etc.
-
-*E.G.
-
- In> IsOdd(4);
- Out> False;
- In> IsOdd(-1);
- Out> True;
-
-*SEE IsEven, IsInteger
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOne.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOne.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOne.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOne.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,7 +0,0 @@
-%mathpiper,def="IsOne",private="true"
-
-// why do we need this? Why doesn't x=1 not work?
-10 # IsOne(x_IsNumber) <-- IsZero(SubtractN(x,1));
-60000 # IsOne(_x) <-- False;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOrthogonal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOrthogonal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsOrthogonal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsOrthogonal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def="IsOrthogonal"
-
-IsOrthogonal(A_IsMatrix) <-- (Transpose(A)*A=Identity(Length(A)));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsOrthogonal",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsOrthogonal --- test for an orthogonal matrix
-*STD
-*CALL
- IsOrthogonal(A)
-
-*PARMS
-
-{A} -- square matrix
-
-*DESC
-
-{IsOrthogonal(A)} returns {True} if {A} is orthogonal and {False}
-otherwise. $A$ is orthogonal iff $A$*Transpose($A$) = Identity, or
-equivalently Inverse($A$) = Transpose($A$).
-
-*E.G.
-
- In> A := {{1,2,2},{2,1,-2},{-2,2,-1}};
- Out> {{1,2,2},{2,1,-2},{-2,2,-1}};
- In> PrettyForm(A/3)
-
- / \
- | / 1 \ / 2 \ / 2 \ |
- | | - | | - | | - | |
- | \ 3 / \ 3 / \ 3 / |
- | |
- | / 2 \ / 1 \ / -2 \ |
- | | - | | - | | -- | |
- | \ 3 / \ 3 / \ 3 / |
- | |
- | / -2 \ / 2 \ / -1 \ |
- | | -- | | - | | -- | |
- | \ 3 / \ 3 / \ 3 / |
- \ /
- Out> True;
- In> IsOrthogonal(A/3)
- Out> True;
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPolynomialOverIntegers.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPolynomialOverIntegers.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPolynomialOverIntegers.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPolynomialOverIntegers.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,71 +0,0 @@
-%mathpiper,def="IsPolynomialOverIntegers"
-
-Retract("IsPolynomialOverIntegers",*);
-
-10 # IsPolynomialOverIntegers(expr_IsFunction) <--
-[
- Local(x);
- x := VarList(expr)[1];
- IsPolynomialOverIntegers(expr,x);
-];
-
-15 # IsPolynomialOverIntegers(_expr) <-- False;
-
-
-10 # IsPolynomialOverIntegers(_expr,_var)_(CanBeUni(var,expr)) <--
-[
- If( AllSatisfy("IsInteger",Coef(expr,var,0 .. Degree(expr,var))),
- True,
- False
- );
-];
-
-15 # IsPolynomialOverIntegers(_expr,_var) <-- False;
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-%mathpiper_docs,name="IsPolynomialOverIntegers",categories="User Functions;Predicates"
-
-*CMD IsPolynomialOverIntegers --- Check if {expr} is a polynomial in variable {var} all of whose coefficients are integers
-
-*STD
-*CALL
- IsPolynomialOverIntegers(expr,var)
-
-*PARMS
-
-{expr} -- an algebraic expression which may be a polynomial
-
-{var} -- a variable name which might be used in {expr}
-
-*DESC
-
-The command {IsPolynomialOverIntegers} returns {True} if {expr} is a polynomial in {var} and all of its coefficients are integers.
-It returns {False} if {expr} is not a polynomial in {var} or if any of its coefficients are not integers.
-
-This can be important, since many factoring theorems are applicable to such polynomials but not others.
-
-*E.G.
-
-In> IsPolynomialOverIntegers(2*x^3-3*x^2+5*x-14,x)
-Result: True
-
-In> IsPolynomialOverIntegers(2.0*x^3-3*x^2+5*x-14,x)
-Result: False
-
-In> IsPolynomialOverIntegers(y^2-4)
-Result: True
- NOTE: if variable name is omitted, a reasonable default is taken.
-
-In> IsPolynomialOverIntegers(x^2-a^2)
-Result: False
- NOTE: the unbound variable 'a' need not be an integer.
-
-%/mathpiper_docs
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveInteger.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveInteger.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveInteger.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveInteger.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,33 +0,0 @@
-%mathpiper,def="IsPositiveInteger"
-
-IsPositiveInteger(x):= IsInteger(x) And x > 0;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsPositiveInteger",categories="User Functions;Predicates"
-*CMD IsPositiveInteger --- test for a positive integer
-*STD
-*CALL
- IsPositiveInteger(n)
-
-*PARMS
-
-{n} -- integer to test
-
-*DESC
-
-This function tests whether the integer {n} is (strictly) positive. The
-positive integers are 1, 2, 3, 4, 5, etc. If {n} is not a integer, the
-function returns {False}.
-
-*E.G.
-
- In> IsPositiveInteger(31);
- Out> True;
- In> IsPositiveInteger(-2);
- Out> False;
-
-*SEE IsNegativeInteger, IsNonZeroInteger, IsPositiveNumber
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,32 +0,0 @@
-%mathpiper,def="IsPositiveNumber"
-
-IsPositiveNumber(x):= IsNumber(x) And x > 0;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsPositiveNumber",categories="User Functions;Predicates"
-*CMD IsPositiveNumber --- test for a positive number
-*STD
-*CALL
- IsPositiveNumber(n)
-
-*PARMS
-
-{n} -- number to test
-
-*DESC
-
-{IsPositiveNumber(n)} evaluates to {True} if $n$ is (strictly) positive, i.e.
-if $n>0$. If {n} is not a number the function returns {False}.
-
-*E.G.
-
- In> IsPositiveNumber(6);
- Out> True;
- In> IsPositiveNumber(-2.5);
- Out> False;
-
-*SEE IsNumber, IsNegativeNumber, IsNotZero, IsPositiveInteger, IsPositiveReal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveReal.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveReal.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsPositiveReal.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsPositiveReal.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,44 +0,0 @@
-%mathpiper,def="IsPositiveReal"
-
-/* See if a number, when evaluated, would be a positive real value */
-IsPositiveReal(_r) <--
-[
- r:=N(Eval(r));
- (IsNumber(r) And r >= 0);
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsPositiveReal",categories="User Functions;Predicates"
-*CMD IsPositiveReal --- test for a numerically positive value
-*STD
-*CALL
- IsPositiveReal(expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-*DESC
-
-This function tries to approximate "expr" numerically. It returns {True} if this approximation is positive. In case no
-approximation can be found, the function returns {False}. Note that round-off errors may cause incorrect
-results.
-
-*E.G.
-
- In> IsPositiveReal(Sin(1)-3/4);
- Out> True;
- In> IsPositiveReal(Sin(1)-6/7);
- Out> False;
- In> IsPositiveReal(Exp(x));
- Out> False;
-
-The last result is because {Exp(x)} cannot be
-numerically approximated if {x} is not known. Hence
-MathPiper can not determine the sign of this expression.
-
-*SEE IsNegativeReal, IsPositiveNumber, N
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRationalFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRationalFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRationalFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRationalFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,123 +0,0 @@
-%mathpiper,def="IsRationalFunction",scope="private"
-
-Retract("IsRationalFunction",*);
-
-10 # IsRationalFunction(_expr)_(Length(VarList(expr))=0) <-- False;
-
-15 # IsRationalFunction(_expr) <-- IsRationalFunction(expr,VarList(expr)[1]);
-
-10 # IsRationalFunction(expr_IsRationalOrNumber,_x) <-- False;
-
-15 # IsRationalFunction(_expr,_x)_(Type(expr)="/") <--
-[
- If( Contains(VarList(Numerator(expr)),x) Or Contains(VarList(Denominator(expr)),x),
- True,
- False
- );
-];
-
-60000 # IsRationalFunction(_expr,_x) <-- False;
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-%mathpiper_docs,name="IsRationalFunction",categories="Private Functions;Predicates"
-
-*CMD IsRationalFunction --- test for a Rational Function
-*STD
-*CALL
- IsRationalFunction(expr)
- IsRationalFunction(expr,var)
-
-*PARMS
-
-{expr} -- expression to test
-{var} -- (optional) variable
-
-*DESC
-
-This function tests whether the expression {expr} is (strictly) a
-Rational Function of the variable {var}. If {var} is omitted, the
-test is made w.r.t. the first variable (if any) in VarList(expr).
-
-The strict definition of a"rational function" used here requires that
-(a) the {expr} has Type(expr) = "/", and
-(b) either the numerator or the denominator of {expr} contains {var}.
-
-Note that this definition neither requires nor implies that the
-numerator and denominator be polynomials.
-
-*E.G.
-
- In> IsRationalFunction(3,x)
- Out> False
- In> IsRationalFunction(3)
- Out> False;
- In> IsRationalFunction(3.5,x)
- Out> False
- In> IsRationalFunction(3.5)
- Out> False
- In> IsRationalFunction(3/5,x)
- Out> False
- In> IsRationalFunction(3/5)
- Out> False
- In> IsRationalFunction(x,y)
- Out> False
- In> IsRationalFunction(x)
- Out> False
- In> IsRationalFunction(x/y,x)
- Out> True
- In> IsRationalFunction(x/y)
- Out> True
- In> IsRationalFunction(x/5,x)
- Out> True
- In> IsRationalFunction(x/5)
- Out> True
- In> IsRationalFunction(5/x,x)
- Out> True
- In> IsRationalFunction(5/x)
- Out> True
- In> IsRationalFunction(5/y,x)
- Out> False
- In> IsRationalFunction(5/y)
- Out> True
- In> IsRationalFunction(1-1/x,x)
- Out> False
- In> IsRationalFunction(1-1/x)
- Out> False
-
-%/mathpiper_docs
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-Tell(1,IsRationalFunction(3,x));
-Tell(2,IsRationalFunction(3.5,x));
-Tell(3,IsRationalFunction(3/5,x));
-Tell(4,IsRationalFunction(x,y));
-Tell(5,IsRationalFunction(x/y,x));
-Tell(6,IsRationalFunction(x/5,x));
-Tell(7,IsRationalFunction(5/x,x));
-Tell(8,IsRationalFunction(5/y,x));
-Tell(9,IsRationalFunction(1-1/x,x));
-Tell(11,IsRationalFunction(3));
-Tell(12,IsRationalFunction(3.5));
-Tell(13,IsRationalFunction(3/5));
-Tell(14,IsRationalFunction(x));
-Tell(15,IsRationalFunction(x/y));
-Tell(16,IsRationalFunction(x/5));
-Tell(17,IsRationalFunction(5/x));
-Tell(18,IsRationalFunction(5/y));
-Tell(19,IsRationalFunction(1-1/x));
-
-%/mathpiper
-
-
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRational.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRational.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRational.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRational.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,57 +0,0 @@
-%mathpiper,def="IsRational"
-
-/* changed definition of IsRational, Nobbi 030529
-Function("IsRational",{aLeft}) Type(aLeft) = "/";
-
-Function("IsRationalNumeric",{aLeft})
- Type(aLeft) = "/" And
- IsNumber(aLeft[1]) And
- IsNumber(aLeft[2]);
-
-IsRationalOrNumber(_x) <-- (IsNumber(x) Or IsRationalNumeric(x));
-
-10 # IsRationalOrInteger(x_IsInteger) <-- True;
-10 # IsRationalOrInteger(x_IsInteger / y_IsInteger) <-- True;
-20 # IsRationalOrInteger(_x) <-- False;
-
-*/
-
-10 # IsRational(x_IsInteger) <-- True;
-10 # IsRational(x_IsInteger / y_IsInteger) <-- True;
-10 # IsRational(-(x_IsInteger / y_IsInteger)) <-- True;
-60000 # IsRational(_x) <-- False;
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsRational",categories="User Functions;Numbers (Predicates);Predicates"
-*CMD IsRational --- test whether argument is a rational
-*STD
-*CALL
- IsRational(expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-*DESC
-
-This commands tests whether the expression "expr" is a rational
-number, i.e. an integer or a fraction of integers.
-
-*E.G.
-
- In> IsRational(5)
- Out> True;
- In> IsRational(2/7)
- Out> True;
- In> IsRational(0.5)
- Out> False;
- In> IsRational(a/b)
- Out> False;
- In> IsRational(x + 1/x)
- Out> False;
-
-*SEE Numerator, Denominator
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRationalOrNumber.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRationalOrNumber.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsRationalOrNumber.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsRationalOrNumber.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,8 +0,0 @@
-%mathpiper,def="IsRationalOrNumber"
-
-10 # IsRationalOrNumber(x_IsNumber) <-- True;
-10 # IsRationalOrNumber(x_IsNumber / y_IsNumber) <-- True;
-10 # IsRationalOrNumber(-(x_IsNumber / y_IsNumber)) <-- True;
-60000 # IsRationalOrNumber(_x) <-- False;
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSkewSymmetric.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSkewSymmetric.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSkewSymmetric.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSkewSymmetric.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,40 +0,0 @@
-%mathpiper,def="IsSkewSymmetric"
-
-IsSkewSymmetric(A_IsMatrix) <-- (Transpose(A)=(-1*A));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsSkewSymmetric",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsSkewSymmetric --- test for a skew-symmetric matrix
-*STD
-*CALL
- IsSkewSymmetric(A)
-
-*PARMS
-
-{A} -- a square matrix
-
-*DESC
-
-{IsSkewSymmetric(A)} returns {True} if {A} is skew symmetric and {False} otherwise.
-$A$ is skew symmetric iff $Transpose(A)$ =$-A$.
-
-*E.G.
-
- In> A := {{0,-1},{1,0}}
- Out> {{0,-1},{1,0}};
- In> PrettyForm(%)
-
- / \
- | ( 0 ) ( -1 ) |
- | |
- | ( 1 ) ( 0 ) |
- \ /
- Out> True;
- In> IsSkewSymmetric(A);
- Out> True;
-
-*SEE IsSymmetric, IsHermitian
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSumOfTerms.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSumOfTerms.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSumOfTerms.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSumOfTerms.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,86 +0,0 @@
-%mathpiper,def="IsSumOfTerms"
-
-// an expression free of the variable -- obviously not a sum of terms in it
-10 # IsSumOfTerms(_var,expr_IsFreeOf(var)) <-- False;
-
-// an Atom cannot be a sum of terms
-12 # IsSumOfTerms(_var,expr_IsAtom()) <-- False;
-
-// after being "Listified", expr is a sum of terms if headed by "+" or "-"
-14 # IsSumOfTerms(_var,expr_IsList())_(expr[1]=Atom("+") Or expr[1]=Atom("-")) <-- True;
-
-// after being "Listified", an expr headed by "*" is not considered a sum
-// of terms unless one or the other operand is free of the variable
-16 # IsSumOfTerms(_var,expr_IsList())_(expr[1]=Atom("*")) <-- Or(IsFreeOf(var,expr[2]),IsFreeOf(var,expr[3]));
-
-// after being "Listified", an expr headed by "/" is not considered a sum
-// of terms unless the denominator (only) is free of the variable
-18 # IsSumOfTerms(_var,expr_IsList())_(expr[1]=Atom("/")) <-- IsFreeOf(var,expr[3]);
-
-// after being "Listified", any other expression is not a sum of terms
-20 # IsSumOfTerms(_var,expr_IsList()) <-- False;
-
-// if we get to this point, Listify the expression and try again
-22 # IsSumOfTerms(_var,_expr) <-- IsSumOfTerms(var,Listify(expr));
-
-%/mathpiper
-
-%mathpiper_docs,name="IsSumOfTerms"
-*CMD IsSumOfTerms --- check for expression being a sum of terms in variable
-
-*STD
-*CALL
- IsSumOfTerms(var,expr)
-
-*PARMS
-
-{var} -- a variable name
-
-{expr} -- an expression to be tested
-
-*DESC
-
-The command {IsSumOfTerms} returns {True} if the expression {expr} can be
-considered to be a "sum of terms" in the given variable {var}. The criteria
-are reasonable but somewhat arbitrary. The criteria were selected after
-a lot of experimentation, specifically to aid the logic used in Integration.
-
-The criteria for {expr} to be a sum of terms in {var} are:
- o {expr} is a function of variable {var}
- o {expr} can best be described as a sum (or difference) of two or more
- functions of {var} OR
- {expr} is a monomial in {var} (this latter is to simplify the logic)
- o {expr} is not better described as a product of functions of {var}
- o {expr} is not better described as a quotient of functions of {var}
- (i.e., is a rational function)
-
-Note that the last three criteria are somewhat subjective!
-
-*E.G.
-
- In> IsSumOfTerms(x,23)
- Result> False
- In> IsSumOfTerms(x,23*x)
- Result> True
- In> IsSumOfTerms(x,5*y)
- Result> False
- In> IsSumOfTerms(x,a*x^2-b*x-c/x)
- Result> True
- In> IsSumOfTerms(x,Sin(x))
- Result> False
- In> IsSumOfTerms(x,Sin(x)+Exp(x))
- Result> True
- In> IsSumOfTerms(x,d*(x^2-1))
- Result> True
- In> IsSumOfTerms(x,(x^2-1)*d)
- Result> True
- In> IsSumOfTerms(x,(x^2-1)/d)
- Result> True
- In> IsSumOfTerms(x,d/(x^2-1))
- Result> False
- In> IsSumOfTerms(x,(x^2-1)*(x^2+1))
- Result> False
- In> IsSumOfTerms(x,(x^2-1)/(x^2+1))
- Result> False
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSymmetric.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSymmetric.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsSymmetric.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsSymmetric.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,47 +0,0 @@
-%mathpiper,def="IsSymmetric"
-
-IsSymmetric(A_IsMatrix) <-- (Transpose(A)=A);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsSymmetric",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsSymmetric --- test for a symmetric matrix
-*STD
-*CALL
- IsSymmetric(A)
-
-*PARMS
-
-{A} -- a matrix
-
-*DESC
-
-{IsSymmetric(A)} returns {True} if {A} is symmetric and {False} otherwise.
-$A$ is symmetric iff Transpose ($A$) =$A$.
-
-*E.G.
-
- In> A := {{1,0,0,0,1},{0,2,0,0,0},{0,0,3,0,0},
- {0,0,0,4,0},{1,0,0,0,5}};
- In> PrettyForm(A)
-
- / \
- | ( 1 ) ( 0 ) ( 0 ) ( 0 ) ( 1 ) |
- | |
- | ( 0 ) ( 2 ) ( 0 ) ( 0 ) ( 0 ) |
- | |
- | ( 0 ) ( 0 ) ( 3 ) ( 0 ) ( 0 ) |
- | |
- | ( 0 ) ( 0 ) ( 0 ) ( 4 ) ( 0 ) |
- | |
- | ( 1 ) ( 0 ) ( 0 ) ( 0 ) ( 5 ) |
- \ /
- Out> True;
- In> IsSymmetric(A)
- Out> True;
-
-
-*SEE IsHermitian, IsSkewSymmetric
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsUnitary.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsUnitary.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsUnitary.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsUnitary.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,35 +0,0 @@
-%mathpiper,def="IsUnitary"
-
-IsUnitary(A_IsMatrix) <-- (Transpose(Conjugate(A))*A = Identity(Length(A)));
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsUnitary",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsUnitary --- test for a unitary matrix
-*STD
-*CALL
- IsUnitary(A)
-
-*PARMS
-
-{A} -- a square matrix
-
-*DESC
-
-This function tries to find out if A is unitary.
-
-A matrix $A$ is orthogonal iff $A^(-1)$ = Transpose( Conjugate($A$) ). This is
-equivalent to the fact that the columns of $A$ build an orthonormal system
-(with respect to the scalar product defined by {InProduct}).
-
-*E.G.
-
- In> IsUnitary({{0,I},{-I,0}})
- Out> True;
- In> IsUnitary({{0,I},{2,0}})
- Out> False;
-
-*SEE IsHermitian, IsSymmetric
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsUpperTriangular.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsUpperTriangular.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsUpperTriangular.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsUpperTriangular.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,54 +0,0 @@
-%mathpiper,def="IsUpperTriangular"
-
-IsUpperTriangular(A_IsMatrix) <--
-[
- Local(i,j,m,n,result);
- m:=Length(A);
- n:=Length(A[1]);
- i:=2;
- result:=(m=n);
- While(i<=m And result)
- [
- j:=1;
- While(j<=n And result)
- [
- result:= (i<=j Or A[i][j] = 0);
- j++;
- ];
- i++;
- ];
- result;
-];
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsUpperTriangular",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsUpperTriangular --- test for an upper triangular matrix
-*STD
-*CALL
- IsUpperTriangular(A)
-
-*PARMS
-
-{A} -- a matrix
-
-*DESC
-
-An upper triangular matrix is a square matrix which has all zero entries above the diagonal.
-
-{IsUpperTriangular(A)} returns {True} if {A} is an upper triangular matrix and {False} otherwise.
-
-*E.G.
- In> IsUpperTriangular(Identity(5))
- Out> True;
- In> IsUpperTriangular({{1,2},{0,1}})
- Out> True;
-
-A non-square matrix cannot be triangular:
- In> IsUpperTriangular({{1,2,3},{0,1,2}})
- Out> False;
-
-*SEE IsLowerTriangle, IsDiagonal
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsVariable.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsVariable.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsVariable.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsVariable.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,5 +0,0 @@
-%mathpiper,def="IsVariable"
-
-IsVariable(_expr) <-- (IsAtom(expr) And Not(expr=Infinity) And Not(expr= -Infinity) And Not(expr=Undefined) And Not(IsNumber(N(Eval(expr)))));
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsZero.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsZero.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/IsZero.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/IsZero.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,43 +0,0 @@
-%mathpiper,def="IsZero"
-
-//10 # IsZero(x_IsNumber) <-- (DivideN( Round( MultiplyN(x, 10^BuiltinPrecisionGet()) ), 10^BuiltinPrecisionGet() ) = 0);
-
-// these should be calls to MathSign() and the math library should do this. Or it should be just MathEquals(x,0).
-// for now, avoid underflow and avoid IsZero(10^(-BuiltinPrecisionGet())) returning True.
-10 # IsZero(x_IsNumber) <-- ( MathSign(x) = 0 Or AbsN(x) < PowerN(10, -BuiltinPrecisionGet()));
-60000 # IsZero(_x) <-- False;
-
-//Note:tk:moved here from univariate.rep.
-20 # IsZero(UniVariate(_var,_first,_coefs)) <-- IsZeroVector(coefs);
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsZero",categories="User Functions;Numbers (Predicates);Predicates"
-*CMD IsZero --- test whether argument is zero
-*STD
-*CALL
- IsZero(n)
-
-*PARMS
-
-{n} -- number to test
-
-*DESC
-
-{IsZero(n)} evaluates to {True} if
-"n" is zero. In case "n" is not a number, the function returns
-{False}.
-
-*E.G.
-
- In> IsZero(3.25)
- Out> False;
- In> IsZero(0)
- Out> True;
- In> IsZero(x)
- Out> False;
-
-*SEE IsNumber, IsNotZero
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/ListHasFunc.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/ListHasFunc.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/ListHasFunc.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/ListHasFunc.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,9 +0,0 @@
-%mathpiper,def="ListHasFunc"
-
-/// ListHasFunc --- test for one of the elements of a list to contain a function
-/// this is mainly useful to test whether a list has nested lists, i.e. ListHasFunc({1,2,3}, List)=False and ListHasFunc({1,2,{3}}, List)=True.
-// need to exclude the List atom itself, so don't use Listify
-19 # ListHasFunc({}, _atom) <-- False;
-20 # ListHasFunc(expr_IsList, atom_IsAtom) <-- HasFunc(First(expr), atom) Or ListHasFunc(Rest(expr), atom);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/ListHasFuncSome.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/ListHasFuncSome.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/ListHasFuncSome.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/ListHasFuncSome.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,6 +0,0 @@
-%mathpiper,def="ListHasFuncSome",scope="private"
-
-19 # ListHasFuncSome({}, _atom, _look'list) <-- False;
-20 # ListHasFuncSome(expr_IsList, atom_IsAtom, _look'list) <-- HasFuncSome(First(expr), atom, look'list) Or ListHasFuncSome(Rest(expr), atom, look'list);
-
-%/mathpiper
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/matrix.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/matrix.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/matrix.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/matrix.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,240 +0,0 @@
-%mathpiper,def="IsScalar;IsMatrix;IsVector;IsSquareMatrix"
-
-/* def file definitions
-IsScalar
-IsMatrix
-IsVector
-IsSquareMatrix
-*/
-
-LocalSymbols(p,x)
-[
-// test for a scalar
-Function("IsScalar",{x}) Not(IsList(x));
-
-
-
-// test for a vector
-Function("IsVector",{x})
- If(IsList(x),
- Length(Select(IsList,x))=0,
- False);
-
-// test for a vector w/ element test p
-Function("IsVector",{p,x})
-[
- If(IsList(x),
- [
- Local(i,n,result);
- n:=Length(x);
- i:=1;
- result:=True;
- While(i<=n And result)
- [
- result:=Apply(p,{x[i]});
- i++;
- ];
- result;
- ],
- False);
-];
-
-// test for a matrix (dr)
-Function("IsMatrix",{x})
-If(IsList(x) And Length(x)>0,
-[
- Local(n);
- n:=Length(x);
- If(Length(Select(IsVector,x))=n,
- MapSingle(Length,x)=Length(x[1])+ZeroVector(n),
- False);
-],
-False);
-
-// test for a matrix w/ element test p (dr)
-Function("IsMatrix",{p,x})
-If(IsMatrix(x),
-[
- Local(i,j,m,n,result);
- m:=Length(x);
- n:=Length(x[1]);
- i:=1;
- result:=True;
- While(i<=m And result)
- [
- j:=1;
- While(j<=n And result)
- [
- result:=Apply(p,{x[i][j]});
- j++;
- ];
- i++;
- ];
- result;
-],
-False);
-
-/* remove? (dr)
-IsSquareMatrix(_x) <--
-[
- Local(d);
- d:=Dimensions(x);
- Length(d)=2 And d[1]=d[2];
-];
-*/
-
-// test for a square matrix (dr)
-Function("IsSquareMatrix",{x}) IsMatrix(x) And Length(x)=Length(x[1]);
-// test for a square matrix w/ element test p (dr)
-Function("IsSquareMatrix",{p,x}) IsMatrix(p,x) And Length(x)=Length(x[1]);
-
-]; // LocalSymbols(p,x)
-
-%/mathpiper
-
-
-
-%mathpiper_docs,name="IsScalar",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsScalar --- test for a scalar
-*STD
-*CALL
-
- IsScalar(expr)
-
-*PARMS
-
-{expr} -- a mathematical object
-
-*DESC
-
-{IsScalar} returns {True} if {expr} is a scalar, {False} otherwise.
-Something is considered to be a scalar if it's not a list.
-
-*E.G.
- In> IsScalar(7)
- Out> True;
- In> IsScalar(Sin(x)+x)
- Out> True;
- In> IsScalar({x,y})
- Out> False;
-
-*SEE IsList, IsVector, IsMatrix
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="IsVector",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsVector --- test for a vector
-*STD
-*CALL
-
- IsVector(expr)
-
- IsVector(pred,expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-{pred} -- predicate test (e.g. IsNumber, IsInteger, ...)
-
-*DESC
-
-{IsVector(expr)} returns {True} if {expr} is a vector, {False} otherwise.
-Something is considered to be a vector if it's a list of scalars.
-{IsVector(pred,expr)} returns {True} if {expr} is a vector and if the
-predicate test {pred} returns {True} when applied to every element of
-the vector {expr}, {False} otherwise.
-
-*E.G.
- In> IsVector({a,b,c})
- Out> True;
- In> IsVector({a,{b},c})
- Out> False;
- In> IsVector(IsInteger,{1,2,3})
- Out> True;
- In> IsVector(IsInteger,{1,2.5,3})
- Out> False;
-
-*SEE IsList, IsScalar, IsMatrix
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="IsMatrix",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsMatrix --- test for a matrix
-*STD
-*CALL
- IsMatrix(expr)
-
- IsMatrix(pred,expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-{pred} -- predicate test (e.g. IsNumber, IsInteger, ...)
-
-*DESC
-
-{IsMatrix(expr)} returns {True} if {expr} is a matrix, {False} otherwise.
-Something is considered to be a matrix if it's a list of vectors of equal
-length.
-{IsMatrix(pred,expr)} returns {True} if {expr} is a matrix and if the
-predicate test {pred} returns {True} when applied to every element of
-the matrix {expr}, {False} otherwise.
-
-*E.G.
-
- In> IsMatrix(1)
- Out> False;
- In> IsMatrix({1,2})
- Out> False;
- In> IsMatrix({{1,2},{3,4}})
- Out> True;
- In> IsMatrix(IsRational,{{1,2},{3,4}})
- Out> False;
- In> IsMatrix(IsRational,{{1/2,2/3},{3/4,4/5}})
- Out> True;
-
-*SEE IsList, IsVector
-%/mathpiper_docs
-
-
-
-%mathpiper_docs,name="IsSquareMatrix",categories="User Functions;Matrices (Predicates);Predicates"
-*CMD IsSquareMatrix --- test for a square matrix
-*STD
-*CALL
- IsSquareMatrix(expr)
-
- IsSquareMatrix(pred,expr)
-
-*PARMS
-
-{expr} -- expression to test
-
-{pred} -- predicate test (e.g. IsNumber, IsInteger, ...)
-
-*DESC
-
-{IsSquareMatrix(expr)} returns {True} if {expr} is a square matrix,
-{False} otherwise. Something is considered to be a square matrix if
-it's a matrix having the same number of rows and columns.
-{IsMatrix(pred,expr)} returns {True} if {expr} is a square matrix and
-if the predicate test {pred} returns {True} when applied to every
-element of the matrix {expr}, {False} otherwise.
-
-*E.G.
-
- In> IsSquareMatrix({{1,2},{3,4}});
- Out> True;
- In> IsSquareMatrix({{1,2,3},{4,5,6}});
- Out> False;
- In> IsSquareMatrix(IsBoolean,{{1,2},{3,4}});
- Out> False;
- In> IsSquareMatrix(IsBoolean,{{True,False},{False,True}});
- Out> True;
-
-*SEE IsMatrix
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/NoneSatisfy.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/NoneSatisfy.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/predicates/NoneSatisfy.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/predicates/NoneSatisfy.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,40 +0,0 @@
-%mathpiper,def="NoneSatisfy"
-
-10 # NoneSatisfy(pred_IsString,lst_IsList) <-- Not Apply("Or",(MapSingle(pred,lst)));
-
-20 # NoneSatisfy(_pred,_lst) <-- True;
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-%mathpiper_docs,name="NoneSatisfy",categories="User Functions;Predicates"
-
-*CMD NoneSatisfy --- Check if NO element of list {lst} satisfies predicate {pred}
-
-*STD
-*CALL
- NoneSatisfy(pred,lst)
-
-*PARMS
-
-{pred} -- the name of the predicate (as string, with quotes) to be tested
-
-{lst} -- a list
-
-*DESC
-
-The command {NoneSatisfy} returns {True} if NO element of the list {lst} satisfies the predicate {pred}.
-It returns {False} if at least one element of the list satisfies the predicate.
-It also returns {True} if {lst} is not a list, or if {pred} is not a predicate.
-
-*E.G.
-
- In> NoneSatisfy("IsNegativeInteger",{1,0,5})
- Result: True
- In> NoneSatisfy("IsPositiveInteger",{-1,0,5})
- Result: False
-
-%/mathpiper_docs
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/probability/CumulativeDistributionFunction.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/probability/CumulativeDistributionFunction.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/probability/CumulativeDistributionFunction.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/probability/CumulativeDistributionFunction.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,85 +0,0 @@
-%mathpiper,def="CumulativeDistributionFunction"
-
-/* Evaluates distribution dst at point x
- known distributions are:
- 1. Discrete distributions
- -- BernoulliDistribution(p)
- -- BinomialDistribution(p,n)
- -- DiscreteUniformDistribution(a,b)
- -- PoissonDistribution(l)
- -- HypergeometricDistribution(N, M)
- 2. Continuous distributions
- -- ExponentialDistribution(l)
- -- NormalDistrobution(a,s)
- -- ContinuousUniformDistribution(a,b)
- -- tDistribution(m)
- -- GammaDistribution(m)
- -- ChiSquareDistribution(m)
-
- DiscreteDistribution(domain,probabilities) represent arbitrary
- distribution with finite number of possible values; domain list
- contains possible values such that
- Pr(X=domain[i])=probabilities[i].
- TODO: Should domain contain numbers only?
-*/
-
-
-/* Evaluates Cumulative probability function CumulativeDistributionFunction(x)=Pr(X0 And x<=1, p,1));
-11 # CumulativeDistributionFunction(BernoulliDistribution(_p), _x) <-- Hold(If(x<=0,0,If(x>0 And x<=1, p,1)));
-
-10 # CumulativeDistributionFunction(BinomialDistribution(_p,_n),m_IsNumber)_(m<0) <-- 0;
-10 # CumulativeDistributionFunction(BinomialDistribution(_p,n_IsInteger),m_IsNumber)_(m>n) <-- 1;
-10 # CumulativeDistributionFunction(BinomialDistribution(_p,_n),_m) <-- Sum @ { i, 0, Floor(m), ProbabilityDensityFunction(BinomialDistribution(p,n),i)};
-
-10 # CumulativeDistributionFunction(DiscreteUniformDistribution( a_IsNumber, b_IsNumber), x_IsNumber)_(x<=a) <-- 0;
-10 # CumulativeDistributionFunction(DiscreteUniformDistribution( a_IsNumber, b_IsNumber), x_IsNumber)_(x>b) <-- 1;
-10 # CumulativeDistributionFunction(DiscreteUniformDistribution( a_IsNumber, b_IsNumber), x_IsNumber)_(ab, 0 ,1/(b-a+1));
-11 # ProbabilityDensityFunction(DiscreteUniformDistribution(_a,_b), _x) <-- Hold(If(xb, 0 ,1/(b-a+1)));
-
-10 # ProbabilityDensityFunction(PoissonDistribution(_l), n_IsNumber) <-- If(n<0,0,Exp(-l)*l^n/n!);
-11 # ProbabilityDensityFunction(PoissonDistribution(_l),_n) <-- Exp(-l)*l^n/n!;
-
-10 # ProbabilityDensityFunction(GeometricDistribution(_p),_n) <--If(n<0,0,p*(1-p)^n);
-
-10 # ProbabilityDensityFunction(ExponentialDistribution(_l), _x) <-- If(x<0,0,l*Exp(-l*x));
-
-10 # ProbabilityDensityFunction(NormalDistribution(_m,_s),_x) <-- Exp(-(x-m)^2/(2*s))/Sqrt(2*Pi*s);
-
-10 # ProbabilityDensityFunction(ContinuousUniformDistribution(_a,_b),x)_(ab,0,1/(b-a));
-
-10 # ProbabilityDensityFunction(DiscreteDistribution( dom_IsList, prob_IsList), _x)_( Length(dom)=Length(prob) And Simplify(Add(prob))=1) <--
- [
- Local(i);
- i:=Find(dom,x);
- If(i = -1,0,prob[i]);
- ];
-10 # ProbabilityDensityFunction( ChiSquareDistribution( _m),x_IsRationalOrNumber)_(x<=0) <-- 0;
-20 # ProbabilityDensityFunction( ChiSquareDistribution( _m),_x) <-- x^(m/2-1)*Exp(-x/2)/2^(m/2)/Gamma(m/2);
-
-10 # ProbabilityDensityFunction(tDistribution(_m),x) <-- Gamma((m+1)/2)*(1+x^2/m)^(-(m+1)/2)/Gamma(m/2)/Sqrt(Pi*m);
-
-10 # ProbabilityDensityFunction(HypergeometricDistribution( N_IsNumber, M_IsNumber, n_IsNumber), x_IsNumber)_(M <= N And n <= N) <-- (BinomialCoefficient(M,x) * BinomialCoefficient(N-M, n-x))/BinomialCoefficient(N,n);
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-%mathpiper_docs,name="ProbabilityDensityFunction",categories="User Functions;Statistics & Probability"
-*CMD ProbabilityDensityFunction --- probability density function
-*STD
-*CALL
- ProbabilityDensityFunction(dist,x)
-
-*PARMS
-{dist} -- a distribution type
-
-{x} -- a value of random variable
-
-*DESC
-If {dist} is a discrete distribution, then {ProbabilityDensityFunction} returns the
-probability for a random variable with distribution {dist} to take a
-value of {x}. If {dist} is a continuous distribution, then {ProbabilityDensityFunction}
-returns the density function at point $x$.
-
-*SEE CumulativeDistributionFunction, Expectation
-%/mathpiper_docs
\ No newline at end of file
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/ManipEquations.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/ManipEquations.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/ManipEquations.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/ManipEquations.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,189 +0,0 @@
-%mathpiper
-
-Use("org/mathpiper/assembledscripts/proposed.rep/equations.mpi");
-
-Retract("IsEquation",*);
-
-Retract("*==",*);
-Retract("/==",*);
-Retract("+==",*);
-Retract("-==",*);
-Retract("==+",*);
-Retract("==-",*);
-
-10 # IsEquation(expr_IsAtom) <-- False;
-12 # IsEquation(_expr) <--
-[
- Local(EL,res);
- EL := Listify(expr);
- res := (EL[1] = == );
-];
-
-10 # *==(_num,eqn_IsEquation) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( num * EL[2] ));
- RHS := Expand(Simplify( num * EL[3] ));
- LHS == RHS;
-];
-
-10 # *==(eqn_IsEquation,_num) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( num * EL[2] ));
- RHS := Expand(Simplify( num * EL[3] ));
- LHS == RHS;
-];
-
-10 # /==(eqn_IsEquation,_num) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( EL[2] / num ));
- RHS := Expand(Simplify( EL[3] / num ));
- LHS == RHS;
-];
-
-10 # +==(_num,eqn_IsEquation) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( EL[2] + num ));
- RHS := Expand(Simplify( EL[3] + num ));
- LHS == RHS;
-];
-
-10 # +==(eqn_IsEquation,_num) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( EL[2] + num ));
- RHS := Expand(Simplify( EL[3] + num ));
- LHS == RHS;
-];
-
-10 # -==(eqn_IsEquation,_num) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( EL[2] - num ));
- RHS := Expand(Simplify( EL[3] - num ));
- LHS == RHS;
-];
-
-10 # -==(_num,eqn_IsEquation) <--
-[
- Local(EL,LHS,RHS);
- EL := Listify(eqn);
- LHS := Expand(Simplify( num - EL[2] ));
- RHS := Expand(Simplify( num - EL[3] ));
- LHS == RHS;
-];
-
-12 # ==+(eqn1_IsEquation,eqn2_IsEquation) <--
-[
- Local(EL1,LHS,RHS,EL2);
- EL1 := Listify(eqn1);
- EL2 := Listify(eqn2);
- LHS := Expand(Simplify( EL1[2] + EL2[2] ));
- RHS := Expand(Simplify( EL1[3] + EL2[3] ));
- LHS == RHS;
-];
-
-12 # ==-(eqn1_IsEquation,eqn2_IsEquation) <--
-[
- Local(EL1,LHS,RHS,EL2);
- EL1 := Listify(eqn1);
- EL2 := Listify(eqn2);
- LHS := Expand(Simplify( EL1[2] - EL2[2] ));
- RHS := Expand(Simplify( EL1[3] - EL2[3] ));
- LHS == RHS;
-];
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-
-///////////////////////////////////////////////////////////////////////////////
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-Clear(eqns,eq1,eq2,eq3,eq5,eq6,eq7,X,Y,solution);
-
-/* Wade & Taylor, page 222, Example 2 */
-// Solve the pair of equations
-// 2*x + 3*y == 7
-// 3*x - 2*y == 4
-
-eqns := { 2*x+3*y==7, 3*x-2*y==4 };
-Tell(0,eqns);
-NewLine();
-
-// multiply each side of eqns[1] by 2:
-eq1 := *==(2,eqns[1]);
-// multiply each side of eqns[2] by 3:
-eq2 := *==(3,eqns[2]);
-Tell(1,eq1);
-Tell(2,eq2);
-NewLine();
-// add the two equations together
-eq3 := ==+(eq1,eq2);
-Tell(Eq2+Eq3,eq3);
-// solve eq3 for x
-X := Solve(eq3,x);
-Tell(4,X);
-NewLine();
-
-// now multiply each side of eqns[1] by 3:
-eq5 := *==(3,eqns[1]);
-// multiply each side of eqns[2] by 2:
-eq6 := *==(2,eqns[2]);
-Tell(5,eq5);
-Tell(6,eq6);
-NewLine();
-// subtract eq6 from eq5
-eq7 := ==-(eq5,eq6);
-Tell(Eq5-Eq6,eq7);
-// solve eq7 for y
-Y := Solve(eq7,y);
-Tell(8,Y);
-NewLine();
-
-solution := {X,Y};
-Tell(9,solution);
-
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-
- Side effects:
- << 0 >> eqns {2*x+3*y==7,3*x-2*y==4}
-
- << 1 >> eq1 4*x+6*y==14
- << 2 >> eq2 9*x-6*y==12
-
- << Eq2+Eq3 >> eq3 13*x==26
- << 4 >> X {x==2}
-
- << 5 >> eq5 6*x+9*y==21
- << 6 >> eq6 6*x-4*y==8
-
- << Eq5-Eq6 >> eq7 13*y==13
- << 8 >> Y {y==1}
-
- << 9 >> solution {{x==2},{y==1}}
-. %/output
-
-
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/Manipulate.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/Manipulate.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/Manipulate.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/Manipulate.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,55 +0,0 @@
-%mathpiper
-
-Use("org/mathpiper/assembledscripts/proposed.rep/equations.mpi");
-
-Retract("Manipulate",*);
-
-RuleBase("Manipulate",{symbolicEquation});
-HoldArg("Manipulate",symbolicEquation);
-10 # Manipulate(_symbolicEquation)_HasFunc(Eval(symbolicEquation), "==") <--
-[
- Local(listForm, operator, operand, left, right, leftManipulated, rightManipulated, operandIndex, equationIndex, leftOrder, rightOrder);
-
- listForm := Listify(symbolicEquation);
-
- operator := listForm[1];
-
- If(HasFunc(Eval(listForm[2]),"==" ), [operandIndex := 3; equationIndex := 2; ], [ operandIndex := 2; equationIndex := 3;]);
-
- operand := listForm[operandIndex];
- equation := Eval(listForm[equationIndex]);
- left := EquLeft(equation);
- right := EquRight(equation);
-
- If(operandIndex = 3, [ leftOrder := `({left,operand});rightOrder := `({right,operand});], [leftOrder := `({operand,left}); rightOrder := `({operand,right});]);
-
-
- leftManipulated := ExpandBrackets(Simplify(Apply(String(operator), leftOrder)));
- rightManipulated := ExpandBrackets(Simplify(Apply(String(operator), rightOrder)));
-
- leftManipulated == rightManipulated;
-
-];
-
-%/mathpiper
-
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-Clear(equ,a);
-
-equ := y == m*x+b;
-Tell(1, Manipulate(2*equ));
-Tell(2, Manipulate(equ*2));
-Tell(3, Manipulate(2/equ));
-Tell(4, Manipulate(equ/2));
-Tell(5, Manipulate(equ^2));
-
-equ := Sqrt(a) == 3;
-Tell(6, Manipulate(equ^2));
-
-%/mathpiper
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/SolveSetEqns.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/SolveSetEqns.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/equations/SolveSetEqns.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/equations/SolveSetEqns.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,186 +0,0 @@
-%mathpiper
-
-Use("org/mathpiper/assembledscripts/proposed.rep/equations.mpi");
-
-Retract("SolveLinearSysViaMatrix",*);
-
-Retract("SolveLinearSystemViaGauss",*);
-
-Retract("CheckEquationSolution",*);
-
-
-
-10 # SolveLinearSysViaMatrix( eqns_IsList, vars_IsList ) <--
-[
- /*** NOTE: This function appears to be fully functional, and */
- /*** gives correct answers, but */
- /*** needs some more work to get answers into desired form */
-
- Local(LE,LV,E,LHS,X,M,RHS,LL,eqn,row,ans,Det);
- If(InVerboseMode(),Tell(SolveLinearSysViaMatrix,{eqns,vars}));
- LE := Length(eqns);
- LV := Length(vars);
- E := Assert() LE=LV;
- Check(E,"Number of equations != Number of variables");
-
- LHS := {};
- RHS := {};
- X := vars;
- M := FillList(1,LE);
- ForEach(eqn,eqns)
- [
- E := Listify(eqn);
- LL := E[2];
- RHS := E[3]:RHS;
- row := Map("Coef",{FillList(LL,LE),X,M});
- LHS := row:LHS;
- ];
- LHS := DestructiveReverse(LHS);
- RHS := DestructiveReverse(RHS);
- Det := Determinant(LHS);
- //Tell(det,Det);
-
- ans :=MatrixSolve(LHS,RHS);
-];
-
-12 # SolveLinearSysViaMatrix( _eqns, _vars ) <-- False;
-
-
-
-
-10 # SolveLinearSystemViaGauss( eqns_IsList, vars_IsList ) <--
-[
- /***** WARNING: This version is valid for TWO equations only *****/
-
- Local(LE,LV,E,E2,s,s1,s2,s3,ans);
- If(InVerboseMode(),Tell(SolveLinearSysViaGauss,{eqns,vars}));
- LE := Length(eqns);
- LV := Length(vars);
- E := Assert() LE=LV;
- Check(E,"Number of equations != Number of variables");
-
- If(InVerboseMode(),Tell(0,{LE,LV,E}));
- s := Solve( eqns, vars )[1];
- If(InVerboseMode(),Tell(1,s));
- s1 := s[1];
- s2 := s[2];
- s3 := s[3];
- E2 := Listify(s3);
- s2 := (s2 Where s3);
- s1 := (s1 Where s2 And s3);
- If( E2[2]=E2[3], ans:=Inconsistent-Set, ans:=List(s1,s2,s3));
- ans;
-];
-
-12 # SolveLinearSystemViaGauss( _eqns, _vars ) <-- False;
-
-
-
-
-10 # CheckEquationSolution( eqn_IsEquation, soln_IsList ) <--
-[
- Local(EL,LHS,RHS,L,svar,sval);
- If(InVerboseMode(),Tell(CheckOneEq,{eqn,soln}));
- EL := Listify(eqn);
- LHS := Expand(Simplify( EL[2] ));
- RHS := Expand(Simplify( EL[3] ));
- L := Listify(soln[1]);
- svar := L[2];
- sval := L[3];
- If( InVerboseMode(), [Tell(2,{LHS,RHS}); Tell(3,{svar,sval});]);
- V := Eliminate(svar,sval,LHS);
- If(InVerboseMode(),Tell(4,V));
- V = RHS;
-];
-
-12 # CheckEquationSolution( eqns_IsList, solns_IsList ) <--
-[
- Tell(CheckSetOfEqns,{eqns,solns});
- Check(False,"Not implemented yet");
-];
-
-14 # CheckEquationSolution( _eq, _soln ) <--
-[
- Tell(CheckEqnLeftovers,{eq,soln});
- False;
-];
-
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-
-///////////////////////////////////////////////////////////////////////////////
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-Clear(eqns1,eqns2,eqns3,eqns4,eqns5,solution);
-
-// --- Test the new solver for sets of linear equations ---
-
-NewLine();
-
-eqns1 := {2*x-2*y+z==(-7),3*x+y+2*z==(-2),5*x+3*y-3*z==(-7)}; // 3 eqns, 3 unknowns
-Tell(Independent,eqns1);
-solution := SolveLinearSysViaMatrix(eqns1,{x,y,z});
-Tell(11,solution);
-NewLine();
-
-eqns2 := {3*x-2*y+z==1,x-y-z==2,6*x-4*y+2*z==3}; // 3 eqns, 3 unks, inconsistent
-Tell(Inconsistent,eqns2);
-solution := SolveLinearSysViaMatrix(eqns2,{x,y,z});
-Tell(13,solution);
-NewLine();
-
-eqns3 := {2*x+3*y==12,3*x+2*y==12}; // 2 eqns, 2 unknown, independent
-Tell(Independent,eqns3);
-solution := SolveLinearSysViaMatrix(eqns3,{x,y});
-Tell(15,solution);
-NewLine();
-
-eqns4 := {2*x+3*y==6,4*x+6*y==12}; // 2 eqns, 2 unknowns, dependent
-Tell(Dependent,eqns4);
-solution := SolveLinearSysViaMatrix(eqns4,{x,y});
-Tell(17,solution);
-NewLine();
-
-eqns5 := {2*x+3*y==6,2*x+3*y==8}; // 2 eqns, 2 unknowns, parallel (inconsistent)
-Tell(Inconsistent,eqns5);
-solution := SolveLinearSysViaMatrix(eqns5,{x,y});
-Tell(19,solution);
-NewLine();
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-
- Side effects:
- << Independent >> eqns1 {2*x-2*y+z==(-7),3*x+y+2*z==(-2),5*x+3*y-3*z==(-7)}
- << det >> Det -52
- << 11 >> solution {-2,2,1}
-
- << Inconsistent >> eqns2 {3*x-2*y+z==1,x-y-z==2,6*x-4*y+2*z==3}
- << det >> Det 0
- << 13 >> solution {Undefined,Infinity,Infinity}
-
- << Independent >> eqns3 {2*x+3*y==12,3*x+2*y==12}
- << det >> Det -5
- << 15 >> solution {12/5,12/5}
-
- << Dependent >> eqns4 {2*x+3*y==6,4*x+6*y==12}
- << det >> Det 0
- << 17 >> solution {Undefined,Undefined}
-
- << Inconsistent >> eqns5 {2*x+3*y==6,2*x+3*y==8}
- << det >> Det 0
- << 19 >> solution {Infinity,Infinity}
-. %/output
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraHistogram.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraHistogram.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraHistogram.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraHistogram.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,92 +0,0 @@
-%mathpiper
-
-GeoGebraHistogram(classBoundaries, data) :=
-[
- Local(command);
- //todo:tk: a check must be made to make sure that all data items fit into the class boundaries.
- // If they don't, GeoGebra will not accept them.
-
- command := PatchString("Histogram[,]");
- JavaCall(geogebra, "evalCommand", command);
-];
-
-
-
-
-GeoGebraHistogram(data) :=
-[
- Local(command, classBoundaries, noDuplicatesSorted, largestValue, smallestValue, x, numberOfUniqueValues);
-
- noDuplicatesSorted := HeapSort(RemoveDuplicates(data), "<" );
-
- smallestValue := Floor(noDuplicatesSorted[1]);
-
- numberOfUniqueValues := Length(noDuplicatesSorted);
-
- largestValue := Ceil(noDuplicatesSorted[Length(noDuplicatesSorted)]);
-
- classBoundaries := N(Table(x,x,smallestValue-.5,largestValue+.5,1));
-
- command := PatchString("Histogram[,]");
- JavaCall(geogebra, "evalCommand", command);
-];
-
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-GeoGebraHistogram({1, 2, 3, 4}, {1.0, 1.1, 1.1, 1.2, 1.7, 2.2, 2.5, 4.0});
-
-%/mathpiper
-
- %output,preserve="false"
- Result: java.lang.Boolean
-. %/output
-
-
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-GeoGebraHistogram({1.0, 1.1, 1.1, 1.2, 1.7, 2.2, 2.5, 4.0});
-
-%/mathpiper
-
- %output,preserve="false"
- Result: java.lang.Boolean
-. %/output
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-GeoGebraHistogram(N({16+3/8, 16+3/8, 17+1/8, 16, 14+3/8, 17+1/4, 16+5/8, 16, 17, 17+1/4, 17, 15+7/8, 16+5/8, 16+1/8, 17+1/8, 16+7/8, 16+3/8, 16+3/8, 16+7/8, 17+1/8, 17, 16+3/4, 17+1/4, 17+1/8, 15+3/8}));
-
-%/mathpiper
-
- %output,preserve="false"
- Result: true
-. %/output
-
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-classBoundaries := N(Table(x,x,14,20,1/4));
-
-E := N({16+3/8, 16+3/8, 17+1/8, 16, 14+3/8, 17+1/4, 16+5/8, 16, 17, 17+1/4, 17, 15+7/8, 16+5/8, 16+1/8, 17+1/8, 16+7/8, 16+3/8, 16+3/8, 16+7/8, 17+1/8, 17, 16+3/4, 17+1/4, 17+1/8, 15+3/8});
-
-D := N({18+1/4, 19+1/4, 18+1/4, 15+5/8, 17+5/8, 17+1/2, 17+1/8, 17+1/8, 17+1/2, 14+1/2, 17+3/8, 16+7/8, 17+3/4, 18+7/8, 14+7/8, 19+1/4, 18+1/8, 16+1/4, 16+1/8, 16+3/4, 17+1/4, 17+3/8, 17+1/8, 17+1/2, 16+5/8});
-
-GeoGebraHistogram(classBoundaries,Concat(D,E));
-
-%/mathpiper
-
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebra.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebra.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebra.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebra.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,45 +0,0 @@
-%mathpiper,def="GeoGebra",scope="private"
-
-Retract("GeoGebra",*);
-
-LocalSymbols(options)
-[
- options := {};
-
- Local(updateObjects);
-
- updateObjects := "";
-
- options["updateObjects"] := updateObjects;
-
-
-
-GeoGebra() := options;
-
-
-GeoGebra(list) := (options := list);
-
-
-
-];
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
-
-
-%mathpiper,scope="nobuild",subtype="manual_test"
-
-Use("org/mathpiper/assembledscripts/proposed.rep/geogebra.mpi");
-
-%/mathpiper
-
- %output,preserve="false"
- Result: True
-. %/output
-
-
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraPlot.mrw mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraPlot.mrw
--- mathpiper-0.0.svn2556/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraPlot.mrw 2009-10-06 15:12:53.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/scripts3/proposed/geogebra/GeoGebraPlot.mrw 1970-01-01 00:00:00.000000000 +0000
@@ -1,147 +0,0 @@
-%mathpiper,def="GeoGebraPlot",scope="private"
-Retract("GeoGebraPlot",*);
-
-RuleBaseListed("GeoGebraPlot",{arg1,arg2});
-
-
-
-5 # GeoGebraPlot(_arg1) <-- GeoGebraPlot(arg1,{}); //Handle single argument call.
-
-
-20 # GeoGebraPlot(function_IsFunction, options_IsList)_(Not IsList(function)) <--
-[
- Local(command);
-
- function := (Subst(==,=) function);
-
- command := ConcatStrings(ToString()Write(function));
-
- JavaCall(geogebra,"evalCommand",command);
-];
-
-
-
-
-10 # GeoGebraPlot(list_IsList, _options)_(IsEven(Length(list)And IsNumericList(list)) ) <--
-[
- If(IsList(options), options := OptionListToAssociativeList(options), options := OptionListToAssociativeList({options}));
-
- Local(length, index, labelIndex, pointTemplate, segmentCommandTemplate, segmentElementTemplate, command, code, x, y);
-
- length := Length(list);
-
- index := 1;
-
- labelIndex := 1;
-
- pointTemplate := "\"> \" y=\"\" z=\"1.0\"/> ";
- segmentCommandTemplate := "
/(
(
)2)).
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ final double y=X-alpha;
+ return gamma/(Math.PI*(gamma*gamma+y*y));
+ }
+ /**
+ * Cumulative Cauchy distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ return 0.5+Math.atan((X-alpha)/gamma)/Math.PI;
+ }
+ /**
+ * Inverse of the cumulative Cauchy distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return alpha-gamma/Math.tan(Math.PI*probability);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ChiSqrDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,56 @@
+package org.mathpiper.builtin.library.jscistats;
+
+
+/**
+* The ChiSqrDistribution class provides an object for encapsulating chi-squared distributions.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public final class ChiSqrDistribution extends ProbabilityDistribution {
+ private double r;
+// The ChiSqr and Gamma distributions are closely related.
+ private GammaDistribution gamma;
+
+ /**
+ * Constructs a chi-squared distribution.
+ * @param dgr degrees of freedom.
+ */
+ public ChiSqrDistribution(double dgr) {
+ if(dgr<=0.0)
+ throw new OutOfRangeException("The degrees of freedom must be greater than zero.");
+ r=dgr;
+ gamma=new GammaDistribution(0.5*r);
+ }
+ /**
+ * Returns the degrees of freedom.
+ */
+ public double getDegreesOfFreedom() {
+ return r;
+ }
+ /**
+ * Probability density function of a chi-squared distribution.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ return 0.5*gamma.probability(0.5*X);
+ }
+ /**
+ * Cumulative chi-squared distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return SpecialMath.incompleteGamma(0.5*r,0.5*X);
+ }
+ /**
+ * Inverse of the cumulative chi-squared distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ if(probability==1.0)
+ return Double.MAX_VALUE;
+ else
+ return 2.0*gamma.inverse(probability);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExponentialDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,80 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The ExponentialDistribution class provides an object for encapsulating exponential distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class ExponentialDistribution extends ProbabilityDistribution {
+ private double lambda;
+
+ /**
+ * Constructs the standard exponential distribution.
+ */
+ public ExponentialDistribution() {
+ this(1.0);
+ }
+ /**
+ * Constructs an exponential distribution.
+ * @param decay the scale parameter.
+ */
+ public ExponentialDistribution(double decay) {
+ if(decay<0.0)
+ throw new OutOfRangeException("The scale parameter should be positive.");
+ lambda=decay;
+ }
+ /**
+ * Constructs an exponential distribution from a data set.
+ * @param array a sample.
+ */
+ public ExponentialDistribution(double array[]) {
+ double sumX=array[0];
+ for(int i=1;i
X.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return lambda*Math.exp(-lambda*X);
+ }
+ /**
+ * Cumulative exponential distribution function.
+ * @return the probability that a stochastic variable x is less then X, i.e. P(x<X).
+ */
+ public double cumulative(double X) {
+ checkRange(X,0.0,Double.MAX_VALUE);
+ return 1.0-Math.exp(-lambda*X);
+ }
+ /**
+ * Inverse of the cumulative exponential distribution function.
+ * @return the value X for which P(x<X).
+ */
+ public double inverse(double probability) {
+ checkRange(probability);
+ return -Math.log(1.0-probability)/lambda;
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ExtraMath.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,346 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+ * The extra math library.
+ * Provides extra functions not in java.lang.Math class.
+ * This class cannot be subclassed or instantiated because all methods are static.
+ * @version 1.2
+ * @author Mark Hale
+ */
+public final class ExtraMath extends AbstractMath {
+ private ExtraMath() {}
+
+ /**
+ * Rounds a number to so many significant figures.
+ * @param x a number to be rounded.
+ * @param significant number of significant figures to round to.
+ */
+ public static double round(final double x, final int significant) {
+ if(x == 0.0)
+ return x;
+ else if(significant == 0)
+ return 0.0;
+ final double signedExp = log10(Math.abs(x)) - significant;
+ if(signedExp < 0.0) {
+ // keep the exponent positive so factor is representable
+ final double factor = Math.pow(10.0, Math.floor(-signedExp));
+ return Math.round(x*factor)/factor;
+ } else {
+ final double factor = Math.pow(10.0, Math.ceil(signedExp));
+ return Math.round(x/factor)*factor;
+ }
+ }
+ /**
+ * Returns a random number within a specified range.
+ */
+ public static double random(double min, double max) {
+ return (max-min)*Math.random()+min;
+ }
+ /**
+ * Returns the sign of a number.
+ * @return 1 if x>0.0, -1 if x<0.0, else 0.
+ */
+ public static int sign(double x) {
+ if(x > 0.0)
+ return 1;
+ else if(x < 0.0)
+ return -1;
+ else
+ return 0;
+ }
+ /**
+ * Returns sqrt(x2+y2).
+ */
+ public static double hypot(final double x,final double y) {
+ final double xAbs=Math.abs(x);
+ final double yAbs=Math.abs(y);
+ if(xAbs==0.0 && yAbs==0.0)
+ return 0.0;
+ else if(xAbs
.
+ */
+ double SQRT2PI=2.5066282746310005024157652848110452530069867406099;
+ /**
+ * Natural logarithm of 10.
+ */
+ double LOG10=2.30258509299404568401799145468436420760110148862877;
+ /**
+ * Euler's gamma constant.
+ * @jsci.planetmath EulersConstant
+ */
+ double GAMMA=0.57721566490153286060651209008240243104215933593992;
+ /**
+ * Golden ratio.
+ * @jsci.planetmath GoldenRatio
+ */
+ double GOLDEN_RATIO=1.6180339887498948482045868343656381177203091798058;
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/OutOfRangeException.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,21 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* This exception occurs if an argument in a statistics function is out-of-range.
+* @version 1.0
+* @author Jaco van Kooten
+*/
+public class OutOfRangeException extends IllegalArgumentException {
+ /**
+ * Constructs an OutOfRangeException with no detail message.
+ */
+ public OutOfRangeException() {
+ }
+ /**
+ * Constructs an OutOfRangeException with the specified detail message.
+ */
+ public OutOfRangeException(String s) {
+ super(s);
+ }
+}
+
diff -Nru mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java
--- mathpiper-0.0.svn2556/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java 1970-01-01 00:00:00.000000000 +0000
+++ mathpiper-0.81f+dfsg1/src/org/mathpiper/builtin/library/jscistats/ParetoDistribution.java 2010-01-16 04:03:17.000000000 +0000
@@ -0,0 +1,77 @@
+package org.mathpiper.builtin.library.jscistats;
+
+/**
+* The ParetoDistribution class provides an object for encapsulating Pareto distributions.
+* @version 0.2
+* @author Mark Hale
+*/
+public final class ParetoDistribution extends ProbabilityDistribution {
+ private double shape;
+ private double scale;
+
+ /**
+ * Constructs a Pareto distribution.
+ * @param sh the shape.
+ * @param sc the scale.
+ */
+ public ParetoDistribution(double sh,double sc) {
+ if(sh<0.0)
+ throw new OutOfRangeException("The shape parameter should be positive.");
+ shape=sh;
+ if(sc<0.0)
+ throw new OutOfRangeException("The scale paremeter should be positive.");
+ scale=sc;
+ }
+ /**
+ * Returns the shape parameter.
+ */
+ public double getShapeParameter() {
+ return shape;
+ }
+ /**
+ * Returns the scale parameter.
+ */
+ public double getScaleParameter() {
+ return scale;
+ }
+ /**
+ * Returns the mean.
+ */
+ public double getMean() {
+ return shape*scale/(shape-1.0);
+ }
+ /**
+ * Returns the variance.
+ */
+ public double getVariance() {
+ return shape*scale*scale/((shape-2.0)*(shape-1.0)*(shape-1.0));
+ }
+ /**
+ * Probability density function of a Pareto distribution.
+ * P(X) = (a/X) (s/X)a.
+ * @return the probability that a stochastic variable x has the value X, i.e. P(x=X).
+ */
+ public double probability(double X) {
+ if(X