From: Barton W. <wil...@us...> - 2012-12-15 13:58:01
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima, A Computer Algebra System". The branch, master has been updated via 70329fb1662d25d3a8284dca4f2a209439590a47 (commit) via ee729b508e23b5f2f8e770175a10c0581e6c7720 (commit) from 925e3f226b91258a52644c3fbe796354c3c8f0fc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 70329fb1662d25d3a8284dca4f2a209439590a47 Author: Barton Willis <wi...@un...> Date: Sat Dec 15 07:56:54 2012 -0600 o Fix for approx-alike bug: ?approx\-alike(a[1],a(1)) --> true (see http://www.math.utexas.edu/pipermail/maxima/2012/030881.html) Signed-off-by: Barton Willis <wi...@un...> diff --git a/src/mload.lisp b/src/mload.lisp index cf7b6dd..245287e 100644 --- a/src/mload.lisp +++ b/src/mload.lisp @@ -249,43 +249,27 @@ ;; ''(taylor(x,x,0,2) (defun approx-alike (f g) - (cond ((floatp f) (and (floatp g) ($float_approx_equal f g))) - (($bfloatp f) (and ($bfloatp g) ($bfloat_approx_equal f g))) - - (($taylorp g) - (approx-alike 0 (sub (ratdisrep f) (ratdisrep g)))) - + (($ratp f) (approx-alike g (ratdisrep f))) + (($ratp g) (approx-alike g f)) ((atom f) (and (atom g) (equal f g))) - - ((op-equalp f 'lambda) - (and (op-equalp g 'lambda) + ;; allow a test such as sign(z); 'pnz$ to pass + ((and (eq 'mquote (mop f)) (not (and (consp g) (consp (car g)) (eq 'mquote (mop g))))) + (approx-alike (second f) g)) + ((atom g) (equal f g)) + ((eq 'lambda (mop f)) + (and (eq 'lambda (mop g)) (approx-alike-list (mapcar #'(lambda (s) (simplifya s nil)) (margs f)) (mapcar #'(lambda (s) (simplifya s nil)) (margs g))))) - ((arrayp f) (and (arrayp g) (approx-alike ($listarray f) ($listarray g)))) - ((hash-table-p f) (and (hash-table-p g) (approx-alike ($listarray f) ($listarray g)))) - - (($ratp f) - (and ($ratp g) (approx-alike (ratdisrep f) (ratdisrep g)))) - - ;; maybe we don't want this. - ((op-equalp f 'mquote) - (approx-alike (second f) g)) - - ;; I'm pretty sure that (mop f) and (mop g) won't signal errors, but - ;; let's be extra careful. - - ((and (consp f) (consp (car f)) (consp g) (consp (car g)) + ((and (eq (not (memq 'array (car f))) (not (memq 'array (car g)))) (or (approx-alike (mop f) (mop g)) - (and (symbolp (mop f)) (symbolp (mop g)) - (approx-alike ($nounify (mop f)) ($nounify (mop g))))) - (approx-alike-list (margs f) (margs g)))) - + (and (symbolp (mop f)) (symbolp (mop g)) (approx-alike ($nounify (mop f)) ($nounify (mop g)))))) + (approx-alike-list (margs f) (margs g))) (t nil))) (defun approx-alike-list (p q) commit ee729b508e23b5f2f8e770175a10c0581e6c7720 Author: Barton Willis <wi...@un...> Date: Sat Dec 15 07:32:50 2012 -0600 o Fix for bug 2515: declare various variables to be local. o Use is notequal instead of nonstandard function "compare." diff --git a/share/linearalgebra/linearalgebra.mac b/share/linearalgebra/linearalgebra.mac index 040c341..358942d 100644 --- a/share/linearalgebra/linearalgebra.mac +++ b/share/linearalgebra/linearalgebra.mac @@ -54,14 +54,14 @@ dotproduct(a,b) := block([scalarmatrixp : true], ctranspose(a) . b); nullspace(m) := block([nr, nc, acc : set(), proviso : true, pv, prederror : false], - + local(m), require_unblockedmatrix(m, "first", "nullspace"), /* nc and nr are the sizes of the transpose of m */ [nc, nr] : matrix_size(m), m : triangularize(addcol(transpose(m), ident(nr))), for row : 1 thru nr do ( - pv : locate_matrix_entry(m, row, 1, row, nc, lambda([s], compare(s,0) # "="), 'bool), + pv : locate_matrix_entry(m, row, 1, row, nc, lambda([s], is(notequal(s,0))), 'bool), if not(listp(pv)) then ( acc : adjoin(transpose(genmatrix(lambda([ii,j], m[row,j+nc]),1,nr)),acc)) @@ -72,7 +72,7 @@ nullspace(m) := block([nr, nc, acc : set(), proviso : true, pv, prederror : fals print("Proviso: ",proviso), put(concat(outchar, linenum), proviso, 'proviso)), - subst('span, 'set, subset(acc, lambda([s], some(lambda([x], compare(x,0) # "="), s))))); + subst('span, 'set, subset(acc, lambda([s], some(lambda([s], is(notequal(s,0))), s))))); nullity(m) := length(nullspace(m)); @@ -88,6 +88,7 @@ orthogonal_complement([v]) := block([sz], locate_matrix_entry(m, r1, c1, r2, c2, fn, rel) := block([im, cm, mf, e, nr, nc, ok : true, frel], + local(m), require_unblockedmatrix(m, "first", "locate_matrix_entry"), require_integer(r1, "second", "locate_matrix_entry"), require_integer(r2, "second", "locate_matrix_entry"), @@ -142,6 +143,7 @@ print the proviso warnings. linalg_rank(m) := length(columnspace(m)); rowswap(m,i,j) := block([n, p, r], + local(p), require_matrix(m, "first", "rowswap"), require_integer(i, "second", "rowswap"), require_integer(j, "third", "rowswap"), @@ -158,6 +160,7 @@ columnswap(m,i,j) := transpose(rowswap(transpose(m),i,j)); /* row(m,i) <-- row(m,i) - theta * row(m,i) */ rowop(m,i,j,theta) := block([p : copymatrix(m), listarith : true], + local(p), p[i] : p[i] - theta * p[j], p); @@ -169,8 +172,9 @@ hipow_gzero(e,x) := block([n : hipow(e,x)], if n > 0 then n else 'inf); good_pivot(e,x) := freeof(x,e) and e # 0; ptriangularize(m,v) := block([p : ptriangularize_with_proviso(m,v)], - if not(emptyp(p[2])) then print("Proviso: ",p[2]), - p[1]); + local(p), + if not(emptyp(p[2])) then print("Proviso: ",p[2]), + p[1]); ptriangularize_with_proviso(m,v) := block([nr, nc, proviso : [], mp], require_unblockedmatrix(m, "first", "ptriangularize"), @@ -186,6 +190,7 @@ ptriangularize_with_proviso(m,v) := block([nr, nc, proviso : [], mp], column_reduce(m,i,x) := block([nc, nr, pos, q, proviso : []], /* require_matrix(m, "first", "column_reduce"), */ + local(m, pos), nc : length(first(m)), nr : length(m), /* require_integer(i, "second", "column_reduce"), @@ -241,6 +246,7 @@ mat_unblocker(m):=block( else m); mat_trace(m) := block([n, acc : 0], + local(m), if not matrixp(m) then funmake('mat_trace, [m]) else ( n : matrix_size(m), if first(n) # second(n) then error("The first argument to 'mat_trace' must be a square matrix"), ----------------------------------------------------------------------- Summary of changes: share/linearalgebra/linearalgebra.mac | 16 +++++++++---- src/mload.lisp | 38 +++++++++----------------------- 2 files changed, 22 insertions(+), 32 deletions(-) hooks/post-receive -- Maxima, A Computer Algebra System |