From: Richard Fateman <fateman@be...>  20140228 16:50:50

This is probably NOT what you want, which is to learn about rules. But I was thinking that the if the processing is of actual computational interest, it can be done so much faster (different order of processing) I should think about just writing it down. I wrote a simple version in lisp, and it is included below. It works for any number of (singleletter) names and uses alphabetical order. I have perhaps made some other unwarranted assumptions, and I assume that Maxima will simplify some remaining items, and sort the results. but see code. I have not tested this much. (run '((mnctimes) $a $b $b $a $c )) returns ... ((mplus) ((mtimes) 1 ((mnctimes simp) $b)) ((mtimes) 1 ((mnctimes simp) $c $b $b $a $a)) ((mtimes) 1 ((mnctimes simp) $a)) ((mtimes) 1 ((mnctimes simp) $c $b $a)) ((mtimes) 2 ((mnctimes simp) $b $b $a)) ((mtimes) 2 ((mnctimes simp) $b $a $a))) i.e. abbac > b+cbbaa + a + cba+2bba+2baa. #Zeitlinie@... asks Let's say I have two atoms a and b, they can be noncommutatively multiplied, and should satisfy the rule a.b = b.a + 1 now it is (far too) simple to tellsimp(a.b,b.a+1); But this will only apply the rule to a.b The generic case of any product, with any number and order of a and b, is not expanded according to a.b = b.a + 1. How would one do this? ... Actually I'd be very surprised if this would have never been implemented by 'someone', because it is a stripped down version of something that manybody physicist like to do when they 'normal' order bosons (in my case its just single boson). # # Fairly easy and hugely hugely faster to do this without patterns. 1. Convert from a.b.c... to array or string "abc..." 2. Consider 2 hash tables indexed by strings. processing and done. 3. Strings in which the characters are in the proper order are in the table "done" with a count of how many times they were inserted. The empty string is in order. 4. Strings in the processing table are tested: a. If s in proper order, it is removed and the entry in the done table is incremented. If no entry, it is inserted with count 1. b. for each string s in processing, let n be the location of the first pair out of order, s[n] and s[n+1]. i. Insert in the processing table the string s with s[n],s[n+1] reversed. ii. Also insert the string with s[n..n+1] removed. That is, shorter by 2. iii. Finally, remove the string s from the table. 5. If all strings removed from processing table, go through the done table and convert to form you would like. Let the Maxima simplifier simplify 1*b to b etc. # (defun mnc2string(r) ;; assume a.b.c.a.b . Single chars seems to be OK? ;; ((mnctimes simp) $a $b $c ...) (let ((len (length (cdr r))) (inits (mapcar #'(lambda(c)(aref (symbolname c) 1)) (cdr r )))) (makearray len :elementtype 'character :initialcontents inits))) ;; (mnc2string '((mnctimes) $a $b $foo $a $g)) ;; returns "abfag" (defun string2mnc(s) (let ((result nil)) (map nil #'(lambda(c) (push (intern(concatenate 'string '(#\$)(list c))) result)) s) (cons '(mnctimes simp)(nreverse result)))) ;;(string2mnc "abcd") returns ((mnctimes simp) $a $b $c $d) ;; (unorder s) returns integer n if s[n] and s[n+1] are out of order. ;; nil if everything is in order. (defun unorder(s) (let ((h (length s))) (cond ((= h 0) nil) ;; empty string is in order (t (do ((i 0 (1+ i)) (j 1 (1+ j))) ((= j h) nil) (if (charlessp (aref s i)(aref s j))(return i))))))) ;;(unorder "cbab") is 2 ;; (unorder "cba") is nil (defun removepair(s n) ;; remove items n, n+1 from string s of length <n+1 (concatenate 'string (subseq s 0 n) (subseq s (+ 2 n) ))) ;; (removepair "abcdefg" 2) returns "abefg". Note, string index starts at 0 (defun reversepair(s n) ;; remove items n, n+1 from string s of length <n+1 (concatenate 'string (subseq s 0 n) (list (aref s (+ 1 n))(aref s n)) (subseq s (+ 2 n) ))) ;; (reversepair "abcdefg" 2) returns "abdcefg" ;; e.g. (run '((mnctimes) $a $b $c)) ;; assume initial case is one term? (defun run (m) (let ((processing (makehashtable :test 'equalp)) (done (makehashtable :test 'equalp)) (start (mnc2string m)) (res nil)) (setf (gethash start processing ) 1) ;; repeat until processing hash table is empty (while (> (hashtablecount processing) 0) (maphash #'(lambda(key val) (let ((n (unorder key))) (cond ((null n) (setf (gethash key done) (+ val (gethash key done 0))) (remhash key processing)) (t (let ((rem (removepair key n)) (rev (reversepair key n))) (setf (gethash rem processing) (1+(gethash rem processing 0))) (setf (gethash rev processing) (1+(gethash rev processing 0))) (remhash key processing)))))) processing)) (maphash #'(lambda (key val) (push (list '(mtimes) val (string2mnc key)) res)) done) (cons '(mplus) res))) 