;;This is some code to compute a few things concerning multiple zeta values

;;It is written by Karen Yeats, kayeats@bu.edu

;;Since this is but a messy little trinket I don't feel it worthwile to GPL it
;;hence, I, Karen Yeats, herby put this code into the public domain.  Credit
;;where credit is due is always appreciated, though not required.

;;Please see the end of the file for some notes on usage.


;;******* Preliminary functions ******

;;prepend the number element to each word in a linear combination of words
;;in number format
(defun distribute (element list-of-lists)
  (if (null list-of-lists)
      nil
    (cons (list (caar list-of-lists) (cons element (car (cdar list-of-lists))))
	  (distribute element (cdr list-of-lists)))))

;;prepend an x to each word in a linear combination in number format
(defun distributex (list-of-lists)
  (if (null list-of-lists)
      nil
    (cons 
     (list (caar list-of-lists) 
	   (cons (+ 1 (caar (cdar list-of-lists))) 
		 (cdar (cdar list-of-lists))))
     (distributex (cdr list-of-lists)))))
  
(defun scalarprod (number l)
  (mapcar #'(lambda (elt) (cons (* number (car elt)) (cdr elt))) l))

;;calculate y degree of a word w in x and y
(defun ydegree (w)
  (if (null w)
      0
    (if (eq 'y (car w))
	(+ 1 (ydegree (cdr w)))
      (ydegree (cdr w)))))

;;I can't find exponentiation in Lisp so this will suffice: calculate (-1)^i
(defun pairitytosign (i)
  (if (= 0 (mod i 2))
      1
    -1))

;;swap x and y in a word in x y form
(defun ytox (w)
  (if (null w)
      nil
    (if (eq 'x (car w))
	(cons 'y (ytox (cdr w)))
      (cons 'x (ytox (cdr w))))))

;;examples
;;(distribute '3 '((1 (1 2)) (-1 (3 4)) (2 (5 6))))
;;(distributex '((1 (1 2)) (-1 (3 4)) (2 (5 6))))
;;(scalarprod '4 '((1 (1)) (2 (2))))
;;(ydegree '(y x y y x y x y y))
;;(pairitytosign 2)
;;(pairitytosign 3)   
;;(ytox '(x y y x y x x))


;;***** functions concerning combining linear combinations *******

;;insert pair consisting of a coefficient and a word in either format into a 
;;linear combination of words in the same format
(defun insertelement (elt l)
  (if (null l)
      (list elt)
    (if (equal (cdr elt) (cdar l))
	(if (= 0 (+ (car elt) (caar l)))
	    (cdr l)
	  (cons (cons (+ (car elt) (caar l)) (cdr elt)) (cdr l)))
      (cons (car l) (insertelement elt (cdr l))))))

;;add two linear combinations of words
(defun addlist (l1 l2)
  (if (null l2)
      l1
    (addlist (insertelement (car l2) l1) (cdr l2))))

;;subtract two linear combinations of words
(defun subtractlist (l1 l2)
  (if (null l2)
      l1
    (subtractlist (insertelement (cons (* -1 (caar l2)) (cdar l2))
				 l1) 
		  (cdr l2))))

;;collect terms in a linear combination
;;not used at present nor thoroughly tested
(defun simplifylist (l)
  (if (null l)
      nil
    (addlist (list (car l)) (cdr l))))

;;examples
;;(insertelement '(1 (1 2)) '((1 (1 3)) (-4 (1 2))))
;;(insertelement '(1 (x x y)) '((2 (x y)) (-1 (x x y))))
;;(addlist '((1 (1 2)) (3 (2 4)) (2 (2 2))) '((1 (1 3)) (-4 (1 2)) (1 (2 4))))
;;(subtractlist '((1 (1 2)) (2 (1 3))) '((1 (1 3))))


;;******* functions concerning converting between the two word formats *****

;;convert n to x^(n-1)y
(defun convertblock (integer)
  (if (< integer 2)
      '(y)
    (cons 'x (convertblock (- integer 1)))))

;;convert from number form to xy form
(defun convertelement (elt)
  (if (null elt)
      nil
    (append (convertblock (car elt)) (convertelement (cdr elt)))))

;;convert a linear combination in number form to xy form
(defun convert (l)
  (mapcar  #'(lambda (elt) (list (car elt) (convertelement (cadr elt))))
	   l))

;;convert an element from xy for to number form.  For basic use the second
;;parameter should be 1
(defun convertelementback (elt count)
  (if (null elt)
      nil
    (if (equal (car elt) 'y)
	(cons count (convertelementback (cdr elt) 1))
      (convertelementback (cdr elt) (+ 1 count)))))

;;convert a linear combination in xy form to number form
(defun convertback (l)
  (mapcar  #'(lambda (elt) (list (car elt) (convertelementback (cadr elt) 1)))
	   l))

;;examples
;;(convertblock 5)
;;(convertelement '(1 2 3))
;;(convert '((1 (1 2)) (2 (3 4))))
;;(convertelementback '(x x y x y y x x y) 1)
;;(convertback (convert '((1 (1 2)) (2 (3 4)))))


;;***** functions concerning shuffle and stuffle (called here star) *****

;;take the stuffle of two words in number format
(defun wordstar (w1 w2)
  (if (null w1) 
      (list (list 1 w2)) 
    (if (null w2)
	(list (list 1 w1))
      (addlist
       (addlist
	(distribute (car w1) (wordstar (cdr w1) w2))
	(distribute (car w2) (wordstar w1 (cdr w2))))
       (distribute (+ (car w1) (car w2)) (wordstar (cdr w1) (cdr w2)))))))

;;take the shuffle of two words in number format
(defun wordshuffle (w1 w2)
  (if (null w1)
      (list (list 1 w2))
    (if (null w2)
	(list (list 1 w1))
      (addlist
       (if (= 1 (car w1))
	   (distribute 1 (wordshuffle (cdr w1) w2))
	 (distributex (wordshuffle (cons (- (car w1) 1) (cdr w1)) w2)))
       (if (= 1 (car w2))
	   (distribute 1 (wordshuffle w1 (cdr w2)))
	 (distributex (wordshuffle w1 (cons (- (car w2) 1) (cdr w2)))))))))

;;Shuffle a word w in with a formal sum of words l all in number format
(defun wordlistshuffle (w l)
  (if (null l)
      nil
    (addlist (scalarprod (caar l) (wordshuffle w (cadar l)))
	     (wordlistshuffle w (cdr l)))))

;; Shuffle two formal sums of words, l1 and l2 in number format
(defun shuffle (l1 l2)
  (if (null l1)
      nil
    (addlist (scalarprod (caar l1) (wordlistshuffle (cadar l1) l2))
	     (shuffle (cdr l1) l2))))

;; Stuffle a word w with a formal sum of words l all in number format
(defun wordliststar (w l)
  (if (null l)
      nil
    (addlist (scalarprod (caar l) (wordstar w (cadar l)))
	     (wordliststar w (cdr l)))))

;; Stuffle two formal sums of words, l1 and l2 all in number format
(defun star (l1 l2)
  (if (null l1)
      nil
    (addlist (scalarprod (caar l1) (wordliststar (cadar l1) l2))
	     (star (cdr l1) l2))))

;;stuffle ai with bj where the ai and bj are formal sums of words
;;l1 is a list of the ai and l2 is a list of the bj all in number format
(defun crossstar (l1 l2)
  (mapcan #'(lambda (a) 
	      (mapcar #'(lambda (b) (star a b)) l2))
	  l1))

;;shuffle ai with bj where the ai and bj are formal sums of words
;;l1 is a list of the ai and l2 is a list of the bj all in number format
(defun crossshuffle (l1 l2)
  (mapcan #'(lambda (a) 
	      (mapcar #'(lambda (b) (shuffle a b)) l2))
	  l1))

;;word shuffle in the xy format
(defun xywordshuffle (w1 w2)
  (if (null w1)
      (list (list 1 w2))
    (if (null w2)
	(list (list 1 w1))
      (addlist
       (distribute (car w1) (xywordshuffle (cdr w1) w2))
       (distribute (car w2) (xywordshuffle w1 (cdr w2)))))))

;;in the xy format shuffle a word w with a formal sum of words l
(defun xywordlistshuffle (w l)
  (if (null l)
      nil
    (addlist (scalarprod (caar l) (xywordshuffle w (cadar l)))
	     (xywordlistshuffle w (cdr l)))))

;;examples
;;(wordstar '(2) '(1))
;;(wordshuffle '(2) '(3))
;;(wordshuffle '(2) '(1 2))
;;(wordshuffle '(2) '(2 1))
;;(wordlistshuffle '(2) (wordstar '(2) '(1)))
;;(wordlistshuffle '(2) (wordstar '(2) '(1)))
;;(wordliststar '(1) (wordshuffle '(2) '(2)))
;;(crossstar '(( (1 (1 1)) (2 (2 1))) ( (2 (1 2)) (3 (1))))
;;	   '(( (1 (2 2)) (2 (3))) ( (2 (1)) (3 (1 2)))))
;;(star '( (2 (1 2)) (3 (1))) '( (2 (1)) (3 (1 2))))
;;(convertback (xywordshuffle '(x y) '(x y y)))
;;(wordshuffle (convertelementback '(x y) 1) (convertelementback '(x y y) 1))
;;(convertback (xywordlistshuffle '(x x y) (xywordshuffle '(x y) '(x y y))))


;;******* functions concerning generating words ***********

;;generate all words of length length which end in y and if length is at 
;;least 2 begin in x
(defun genwordsxy (length)
  (if (= 1 length)
      '((1 (y)))
    (mapcar #'(lambda (elt) (list 1 (cons 'x elt)))
	    (if (= 2 length)
		'((y))
	      (append
	       (mapcan #'(lambda (elt) (list (cons 'x (cdadr elt))
					     (cons 'y (cdadr elt))))
		       (genwordsxy (- length 1))))))))

;;same as genwordsxy but returned as a list of words rather than a linear
;;combination
(defun genaslist (length)
  (mapcar #'list
   (convertback (genwordsxy length))))

;;generate all words of length length which end in y
(defun ygenwordsxy (length)
  (mapcar #'(lambda (elt) (list 1 elt))
	  (if (= 1 length)
	      '((y))
	    (append
	     (mapcan #'(lambda (elt) (list (cons 'x (cadr elt))
					   (cons 'y (cadr elt))))
		     (ygenwordsxy (- length 1)))))))

;;same as ygenwordsxy but returned as a list of words rather than a linear
;;combination
(defun ygenaslist (length)
  (mapcar #'list
   (convertback (ygenwordsxy length))))

;;generate all words of length length which end in x
(defun xgenwordsxy (length)
  (mapcar #'(lambda (elt) (list 1 elt))
	  (if (= 1 length)
	      '((x))
	    (append
	     (mapcan #'(lambda (elt) (list (cons 'x (cadr elt))
					   (cons 'y (cadr elt))))
		     (xgenwordsxy (- length 1)))))))

;;generate the word (lett)^i
(defun powerword (lett i)
  (if (< i 1)
      nil
    (cons lett (powerword lett (- i 1)))))

;;generate all words of length length except (y y ... y y) (x x ... x x)
(defun genwordsnotallsame (length)
  (subtractlist (append (xgenwordsxy length) (ygenwordsxy length))
		(list (list 1 (powerword 'y length))
		      (list 1 (powerword 'x length)))))

;;examples
;;(genwordsxy 3)
;;(genaslist 3)
;;(genwordsxy 1)
;;(ygenwordsxy 3)
;;(xgenwordsxy 3)
;;(powerword 'x 5)
;;(genwordsnotallsame 3)


;;******** functions concerning regularization *******

;;projection onto words starting in x and ending in y for a single word in xy
;;format
(defun wordproj (w)
  (if (and (eq 'x (car w)) (eq 'y (car(last w))))
      w))

;;projection of a linear combination of words onto words starting in x and 
;;ending in y all in xy format
(defun proj (l)
  (if (null l)
      nil
    (if (null (wordproj (cadar l)))
	(proj (cdr l))
      (cons (car l) (proj (cdr l))))))

;;return (b v) where w = y^b v.  Expects to be called with b=0 initially
(defun pulloffinitials (b w y)
  (if (or (null w) (not (eq y (car w))))
      (list b w)
    (pulloffinitials (+ b 1) (cdr w) y)))

;;convert a word w in xy form to a list (b v a) where w = y^b v x^a
(defun ybvxaform (w)
  (let* ((ylist (pulloffinitials 0 w 'y))
	(revxlist (pulloffinitials 0 (reverse (cadr ylist)) 'x)))
    (list 
     (car ylist)
     (reverse (cadr revxlist))
     (car revxlist))))

;;inner sum of the regularization equation (p39 Schneps notes from Arizona 
;;Winter School 2005)
(defun reginner (s b a r v)
  (scalarprod 
   (pairitytosign (+ r s))
   (proj (xywordlistshuffle 
	(powerword 'y s)
	(xywordshuffle 
	 (append (powerword 'y (- b s)) (append v (powerword 'x (- a r))))
	 (powerword 'x r))))))

;;middle sum of the regularization equation
;;expects to begin with b = s
(defun regmiddle (s b a r v)
  (if (< s 0)
      nil
    (addlist (reginner s b a r v) (regmiddle (- s 1) b a r v))))

;;outer sum of the regularization equation
;;expects to begin with r = a
(defun regouter (b a r v)
  (if (< r 0)
      nil
    (addlist (regmiddle b b a r v) (regouter b a (- r 1) v))))

;;regularize a word in x y form
(defun regularize (w)
  (let ((wlist (ybvxaform w)))
    (regouter (first wlist) (third wlist) (third wlist) (second wlist))))

;;examples
;;(wordproj '(x x y))
;;(wordproj '(y x y))
;;(wordproj '(x y x))
;;(wordproj '(y y x))
;;(proj (ygenwordsxy 3))
;;(pulloffinitials 0 '(x y y x x) 'y)
;;(ybvxaform '(y y x y x y x x x))
;;(regouter 3 3 3 '(x y))
;;(regularize '(y y x y x x))
;;(regularize '(x x y))
;;(regularize '(y x y))


;;***** functions concerning words in xy as non-commutative polynomials ***

;; multiply a word with a list of words as non commutative polys
(defun wordlistpolymult (w l)
  (mapcar #'(lambda (elt) (list (car elt) (append w (cadr elt)))) l))

;; multiply two lists of words as non commutative polys
(defun polymult (l1 l2)
  (if (null l1)
      nil
    (addlist
     (scalarprod (caar l1) 
		 (wordlistpolymult (cadar l1) l2))
     (polymult (cdr l1) l2))))

;; substitute polys for x and y in a word w
(defun substititexy (w newx newy)
  (if (= 1 (length w))
      (if (eq 'x (car w))
	  newx
	newy)
    (if (eq 'x (car w))
	(polymult newx (substititexy (cdr w) newx newy))
      (polymult newy (substititexy (cdr w) newx newy)))))

;;examples
;;(wordlistpolymult '(x y) '((1 (x y)) (2 (y))))
;;(polymult '((1 (x y)) (2 (y))) '((1 (x y)) (2 (y))))
;;(polymult '((1 (x))) '((1 (x))))
;;(substititexy '(x y y) '((1 (x)) (1 (y)) (1 ())) '((1 (y)) (1 ())))


;;***** functions concerning coefficients and coefficient matrices *****
;;***** including printing the coefficient matrix *****

;;pull out coefficient of w in l.  Doesn't assume terms are collected
;;appends non-collected terms
(defun coeff (w l)
  (if (null l)
      nil
    (if (equal w (cadar l))
	(append (caar l) (coeff w (cdr l)))
      (coeff w (cdr l)))))

;;must figure out fns as parameters.  Pulls out coefficient summing
(defun coeffsum (w l)
  (if (null l)
      0
    (if (equal w (cadar l))
	(+ (caar l) (coeffsum w (cdr l)))
      (coeffsum w (cdr l)))))

(defun makerow (l basis)
  (if (null basis)
      nil
    (cons (coeffsum (cadar basis) l) (makerow l (cdr basis)))))

(defun makematrix (list-of-lists basis)
  (if (null list-of-lists)
      nil
    (cons (makerow (car list-of-lists) basis) 
	  (makematrix (cdr list-of-lists) basis))))

(defun printmatrix (m stream)
  (format stream "~%")
  (mapcar #'(lambda (l) (mapcar #'(lambda (elt) (format stream "~D " elt)) l) 
	      (format stream "~%")) m))

;;examples
;;(coeffsum '(3 4) '((1 (1 2)) (2 (3 4))))
;;(makerow '((1 (1 2)) (2 (3 4))) '((1 (3 4)) (1 (5 6)) (1 (1 2))))


;;****** functions concerning the Drinfel'd associator and its relations ****
;;****** I and II ******

;;calculate the Drinfel'd associator
(defun Phi (maxdegree)
  (if (> 2 maxdegree)
      nil
    (append
     (mapcar #'(lambda (elt) (list 
			      (scalarprod (* (pairitytosign (ydegree 
							     (cadr elt))) 
					     (car elt))
					  (regularize (cadr elt))) 
			      (cadr elt)))
	     (genwordsnotallsame maxdegree))
     (Phi (- maxdegree 1)))))
  
;;pull out coefficient of w in x y form from relation I of Phi
(defun coeffPhiI (w)
  (addlist (coeff w (Phi (length w))) (coeff (ytox w) (Phi (length w)))))

;;show all things coming from relation I of Phi up to length length
(defun PhiI (length)
  (mapcan #'(lambda (elt) (list (coeffPhiI (cadr elt)))) 
	  (genwordsnotallsame length)))

;;print the matrix of relation I of Phi.  
(defun phiImain (length)
  (with-open-file (stream (merge-pathnames (format nil "phiImat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (PhiI length) 
					   (genwordsxy length))
			       stream)))

;; substitite for x and y in Phi, doesn't collect terms
(defun subPhi (newx newy length)
  (mapcan #'(lambda (phielt) 
	      (mapcar #'(lambda (subelt) 
			  (list (scalarprod (car subelt) (car phielt))
				(cadr subelt)))
		      (substititexy (cadr phielt) newx newy)))
	      (Phi length)))

;;pull out coeffifcient of w in xy form from relation II of Phi
(defun coeffPhiII (w)
  (addlist
   (addlist (coeff w (Phi (length w)))
	    (coeff w (subPhi '((1 ()) (-1 (x)) (-1 (y))) 
			     '((1 (x))) 
			     (length w))))
   (coeff w (subPhi '((1 (y)))
		    '((1 ()) (-1 (x)) (-1 (y)))
		    (length w)))))

(defun PhiII (length)
  (mapcan #'(lambda (elt) (list (coeffPhiII (cadr elt)))) 
	  (genwordsnotallsame length)))

(defun phiIImain (length)
  (with-open-file (stream (merge-pathnames (format nil "phiIImat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (PhiII length) 
					   (genwordsxy length))
			       stream)))
;;examples
;;(Phi 3)
;;(subPhi '((1 (x)) (1 (y))) '((1 (y)) (1 ())) 3)
;;(PhiII 4)
;;(coeff '(y x x y) (Phi 4))
;;(coeff '(x y y x) (Phi 4))
;;(PhiI 5)
;;(coeffPhiI '(y x x y))


;;***** functions concerning things of the form shuffle - stuffle *****
;;***** for convergent words ****

;;return shuffle - stuffle of two words in number format
(defun wordshuffle-star (w1 w2)
  (subtractlist (wordshuffle w1 w2) (wordstar w1 w2)))

;;return shuffle - stuffle of two linear combinations of words in number form
;;returned as a list of linear combinations
(defun shuffle-starprod (l1 l2)
  (mapcan #'(lambda (elt1) (mapcar #'(lambda (elt2) 
				       (scalarprod (* (car elt1) (car elt2))
						   (wordshuffle-star 
						    (cadr elt1) 
						    (cadr elt2))))
				   l2))
	  l1))

;;recursive helper function for genshuffle-star
(defun gen0shuffle-star (length I)
  (if (< I (ceiling (/ length 2)))
      nil
    (append (shuffle-starprod (convertback (genwordsxy I))
			      (convertback (genwordsxy (- length I))))
	    (gen0shuffle-star length (- I 1)))))

;;generate all linear combinations of the form shuffle - stuffle up to
;;length length
(defun genshuffle-star (length)
  (append (mapcar #'(lambda (elt) (wordshuffle-star (cadr elt) '(1)))
		  (convertback (genwordsxy (- length 1))))
	  (gen0shuffle-star length (- length 2))))

;;print the resulting matrix to the file matn.m where n is length.
;;resulting file is loadable into Maple or Octave (hence presumably Matlab)
(defun main (length)
  (with-open-file (stream (merge-pathnames (format nil "mat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (genshuffle-star length) 
					   (convertback (genwordsxy length)))
			       stream)))

;;examples
;;(shuffle-starprod '((1 (1)) (2 (2))) '((3 (3)) (4 (4))))
;;(wordshuffle-star '(1) '(3))
;;(wordshuffle-star '(1) '(4))
;;(wordshuffle-star '(2) '(3))
;;(wordshuffle-star '(2) '(4))
;;(length (genshuffle-star 6))
;;(main 5)

;;****** variations on functions concerning shuffle - stuffle *****
;;****** first don't require starting with x *****

;;as gen0shuffle-star but don't require first letter to be an x
(defun ygen0shuffle-star (length I)
  (if (< I (ceiling (/ length 2)))
      nil
    (append (shuffle-starprod (convertback (ygenwordsxy I))
			      (convertback (ygenwordsxy (- length I))))
	    (ygen0shuffle-star length (- I 1)))))

;;as gen0shuffle-star but don't require first letter to be an x
(defun ygenshuffle-star (length)
  (ygen0shuffle-star length (- length 1)))

;;print the matrix without requiring the first letter in a word to be x
(defun ymain (length)
  (with-open-file (stream (merge-pathnames (format nil "ymat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (ygenshuffle-star length) 
					   (convertback (ygenwordsxy length)))
			       stream)))

;;examples
;;(ygenshuffle-star 3)
;;(loop for I from 2 to 6 do (ymain I))

;;***** second variation: shuffles and stuffles of (shuffle-stuffle's) ****

;;make a list of formal words of length length resulting from shuffling with 
;;things of the form shuffle-stuffle where the first shuffle-stuffle's are of 
;;length I.  Expects to be called first with I = length - 2
(defun genshuffleshuffle-star (length I)
  (if (< I 4)
      nil
    (append (mapcan #'(lambda (elt) 
			(mapcar #'(lambda (l) (wordlistshuffle (cadr elt) l))
				(genshuffle-star I)))
		    (convertback (genwordsxy (- length I))))
	    (genshuffleshuffle-star length (- I 1)))))
    
;;make a list of formal words of length length resulting from stuffling with 
;;things of the form shuffle-stuffle where the shuffle-stuffle's are of length 
;;I.  Expects to be called first with I = length - 2
(defun genstarshuffle-star (length I)
  (if (< I 4)
      nil
    (append (mapcan #'(lambda (elt) 
			(mapcar #'(lambda (l) (wordliststar (cadr elt) l))
				(genshuffle-star I)))
		    (convertback (genwordsxy (- length I))))
	    (genstarshuffle-star length (- I 1)))))

;;generate all elements of the form shuffle-stuffle and something stuffled with
;;these and something shuffled with these of length length
(defun genprodshuffle-star (length)
  (append (genstarshuffle-star length (- length 2))
	  (append (genshuffleshuffle-star length (- length 2))
		  (genshuffle-star length))))

;;Must combine with main some day: print the matrix for genprodshuffle-star
(defun prodmain (length)
  (with-open-file (stream (merge-pathnames (format nil "pmat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (genprodshuffle-star length) 
					   (convertback (genwordsxy length)))
			       stream)))
;;examples
;;(genshuffleshuffle-star  6 4)
;;(genshuffle-star 4)
;;(genprodshuffle-star 4)
;;(loop for I from 6 to 8 do (prodmain I))

;;*** third variation: elements of the form (a sh b) st c - a sh (b st c) ***

;;generate all elements of the form (a sh b) st c - a sh (b st c) of length 
;;length where a concat b has length at most I and a has length at most J.
;;a can be y or longer, all others have length at least 2. 
(defun genassociator (length I J)
  (if (or (or (< J 1) (< (- I J) 2)) (< (- length I) 2))
      nil
    (append
     (append
      (mapcar #'subtractlist 
	      (crossstar (crossshuffle (genaslist J) (genaslist (- I J)))
			 (genaslist (- length I)))
	      (crossshuffle (genaslist J) 
			    (crossstar (genaslist (- I J)) 
				       (genaslist (- length I)))))
      (genassociator length I (- J 1)))
     (genassociator length (- I 1) (min J (- I 2))))))

(defun associatemain (length)
  (with-open-file (stream (merge-pathnames (format nil "amat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (genassociator length 
							  (- length 2)
							  (- length 4)) 
					   (convertback (genwordsxy length)))
			       stream)))

;;examples
;;(crossshuffle (genaslist 3) (genaslist 3))
;;(crossstar (crossshuffle (genaslist 3) (genaslist 3)) (genaslist 3))
;;(genassociator 7 5 3)
;;(associatemain 5)

;;*** fourth variation: variations 1 and 3 together ****

;;generate all elements of the form (a sh b) st c - a sh (b st c) of length 
;;length where a concat b has length at most I and a has length at most J.
;;first letter is not reqired to be an x, all lengths are at least 1
(defun ygenassociator (length I J)
  (if (or (or (< J 1) (< (- I J) 1)) (< (- length I) 1))
      nil
    (append
     (append
      (mapcar #'subtractlist 
	      (crossstar (crossshuffle (ygenaslist J) (ygenaslist (- I J)))
			 (ygenaslist (- length I)))
	      (crossshuffle (ygenaslist J) 
			    (crossstar (ygenaslist (- I J)) 
				       (ygenaslist (- length I)))))
      (ygenassociator length I (- J 1)))
     (ygenassociator length (- I 1) (min J (- I 1))))))

;;as associatemain but not requiring first letters of words to be x
(defun yassociatemain (length)
  (with-open-file (stream (merge-pathnames (format nil "yamat~D.m" length)) 
			  :direction :output :if-exists :supersede)
		  (printmatrix (makematrix (ygenassociator length 
							  (- length 1)
							  (- length 2)) 
					   (convertback (ygenwordsxy length)))
			       stream)))

;;example
;;(ygenassociator 4 2 1)



;;************************************************************************
;;****************************** Notes ***********************************

;;******* Use *****

;;This code is written in common lisp and should run with any lisp 
;;interpreter.  I usually run it in one of the following two ways (assuming 
;;this file is called mzv.lisp):

;;clisp < mzv.lisp   (if I want to see the output from each command)

;;clisp -C mzv.lisp  (if I have a long computation which prints to a file)


;;******* Basic data types ******

;;A word is represented as either a list of x's and y's eg: (x y y x y x y)
;;or as a list of numbers as per the zeta-value to word in x y conversion
;;eg: (2 1 2 2) is the same word as above

;;A linear combination of words is represented as a list for which each element
;;is a two element list the first element the coefficient, the second the word
;;represented as above.

;;Phi, the Drinfel'd associator returns formal sums of words with coefficients 
;;which are linear combinations of zeta values.  This is represented as a list
;;of pairs with first element a linear combination of words (to be view as
;;zeta of those words) and second element a word.


;;******* Finding your way around *******

;;The most useful basic functions are probably wordshuffle, wordstar, and 
;;xywordshuffle, for basic shuffling and stuffling; regularize, the 
;;(shuffle) regulator; and Phi, the Drinfel'd associator

;;A common theme in this code is calculating all linear combinations 
;;appearing in certain ways.  The result can be viewed as a list of linear 
;;combinations for example
;;(PhiI '4)
;;Or the result can be printed to a file as a matrix. The resulting matrices 
;;are good for things such as calculating the rank.  Note that the columns 
;;correspond to the elements of whichever word generating function is 
;;appropriate, for example the columns of
;;(main 4)
;;correspond to
;;(genwordsxy 4)
;;In the case of the Phi relations the linear combination coming from a 
;;particular word can also be viewed directly, for example
;;(coeffPhiII '(x x y y y))

;;Simply uncomment any of the examples in the above paragraph or elsewhere in 
;;the code to see them in action


;;****** To do ******

;;There are many functions (most notably all the mains) which should be
;;combined into a single function taking one or more functions as parameters.

;;This should be in a better format than a big glob in a single long file



(quit)