diff -u /home/emacsoft/calc-cvs/calccomp.el /home/luk/calc-cvs/calccomp.el --- /home/emacsoft/calc-cvs/calccomp.el 2003-08-01 19:09:54.000000000 +0200 +++ /home/luk/calc-cvs/calccomp.el 2003-08-02 14:44:40.000000000 +0200 @@ -170,7 +170,7 @@ ((eq calc-matrix-just 'center) 'vcent) (t 'vleft))) (break calc-break-vectors)) - (if (and (memq calc-language '(nil big)) + (if (and (eq calc-language nil) (not calc-break-vectors) (math-matrixp a) (not (math-matrixp (nth 1 a))) (or calc-full-vectors @@ -228,6 +228,96 @@ (concat " " right-bracket))))))))) + (if (and (eq calc-language 'big) + (not calc-break-vectors) + (math-matrixp a) (not (math-matrixp (nth 1 a))) + (or calc-full-vectors + (and (< (length a) 7) (< (length (nth 1 a)) 7)) + (progn (setq break t) nil))) + (if (progn + (setq vector-prec (if (or (and calc-vector-commas + (math-vector-no-parens + (nth 1 a))) + (memq 'P calc-matrix-brackets)) + 0 1000)) + (= (length a) 2)) + (list 'horiz + (concat left-bracket left-bracket " ") + (math-compose-vector (cdr (nth 1 a)) + (concat comma " ") + vector-prec) + (concat " " right-bracket right-bracket)) + (let* ((rows (1- (length a))) + (cols (1- (length (nth 1 a)))) + + (matasc + (mapcar (lambda (r) (mapcar + (lambda (e) (calcFunc-cascent e)) + (cdr r))) (cdr a))) + (rowasc (mapcar (lambda (r) (apply 'max r)) matasc)) + (matdesc + (mapcar (lambda (r) (mapcar + (lambda (e) (calcFunc-cdescent e)) + (cdr r))) (cdr a))) + (rowdesc (mapcar (lambda (r) (apply 'max r)) matdesc)) + (basepos (+ (- (/ rows 2) (- 1 (% rows 2))) ;blanks + (let ((res 0) i (auxa rowasc) (auxd rowdesc)) + (progn + (dotimes (i (/ rows 2) res) + (setq res (+ res (car auxa) (car auxd))) + (setq auxa (cdr auxa) auxd (cdr auxd))) + (if (eq (% rows 2) 1) + (+ res (1- (car auxa))) res) + )))) + ) + `(horiz (vleft + ,basepos + ,@(make-list (1- (car rowasc)) '(rule ? )) + ,(concat + (and outer-brackets (concat left-bracket " ")) + (and inner-brackets (concat left-bracket " "))) + ,@(make-list (car rowdesc) '(rule ? )) + ,@(apply 'append (mapcar* (lambda (asc desc) + (append + ;includes blank + (make-list asc '(rule ? )) + (list (concat (and outer-brackets + " ") + (and inner-brackets + (concat left-bracket " ")))) + (make-list desc '(rule ? )) + )) + (cdr rowasc) (cdr rowdesc)))) + + ,@(math-compose-big-matrix (cdr a) 1 cols basepos + matasc rowasc matdesc rowdesc) + (vleft + ,basepos + ,@(let ((res)) (while (cdr rowasc) + (setq res + (append res + (make-list (1- (car rowasc)) '(rule ? )) + (list (if inner-brackets + (concat " " right-bracket + (and row-commas + comma)) + (if (and outer-brackets + row-commas) + comma ""))) + ;includes blank + (make-list (1+ (car rowdesc)) '(rule ? )) + ) + rowasc (cdr rowasc) + rowdesc (cdr rowdesc))) res) + + ,@(make-list (1- (car rowasc)) '(rule ? )) + ,(concat + (and inner-brackets + (concat " " right-bracket)) + (and outer-brackets + (concat " " right-bracket))) + ,@(make-list (car rowdesc) '(rule ? )) + )))) (if (and calc-display-strings (cdr a) (math-vector-is-string a)) @@ -279,7 +369,7 @@ (list 'break math-compose-level) (math-compose-expr (nth (1- (length a)) a) (if (equal comma "") 1000 0)) - right-bracket))))))) + right-bracket)))))))) ((eq (car a) 'incomplete) (if (cdr (cdr a)) (cond ((eq (nth 1 a) 'vec) @@ -944,6 +1034,117 @@ res))) (nreverse res))) +(defun math-compose-big-matrix (a col cols base matasc rowasc + matdesc rowdesc) + "Compose a big matrix of rows in A and COLS columns, with BASE as baseline. +Composition goes column after column." + (let ((col 0) + (res nil) + ) + (while (<= (setq col (1+ col)) cols) + (setq res + (cons (cons just + (cons base (apply 'append + ;same body as in mapcar* below + (append + (make-list (- (car rowasc) + (nth (1- col) + (car matasc))) + '(rule ? )) + (list + (list 'horiz (math-compose-expr + (nth col (car a)) + vector-prec) + (if (= col cols) + "" + (concat + (or calc-vector-commas + " ") " ")))) + (make-list (- (car + rowdesc) + (nth (1- col) + (car matdesc))) + '(rule ? )) + ) + + (mapcar* ;(function + (lambda (r rasc rdesc asc desc) + (append + ;includes blank + (make-list (1+ (- asc (nth (1- + col) + rasc))) + '(rule ? )) + (list + (list 'horiz (math-compose-expr + (nth col r) + vector-prec) + (if (= col cols) + "" + (concat + (or calc-vector-commas + " ") " ")))) + (make-list (- desc (nth + (1- col) + rdesc) ) + '(rule ? )) + ));) + (cdr a) (cdr matasc) (cdr + matdesc) + (cdr rowasc) (cdr rowdesc))))) + res))) + (nreverse res))) + + +(defun math-compose-matrix-flat (a count first) + (if (cdr a) + (if (<= count 0) + (if (< count 0) + (math-compose-matrix-flat (cdr a) -1 nil) + (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") + comma) + (cons (list 'break math-compose-level) + (math-compose-matrix-flat (cdr a) -1 nil)))) + (append (if first (list + 'horiz (list 'set math-compose-level + (length left-bracket)) + left-bracket) nil) + (cons (math-compose-row (car a) nil) + (math-compose-matrix-flat (cdr a) (1- count) nil)))) + (append (if first (list + 'horiz (list 'set math-compose-level + (length left-bracket)) left-bracket) nil) + (list (math-compose-row (car a) t t) + right-bracket)) +)) + +(defun math-compose-row (a nobreak &optional last) + "Composes a complete row of a matrix." + (let ((rlen (if (or calc-full-vectors (< (length a) 7)) (length a) 3))) + (append (list 'horiz (list 'set (1+ math-compose-level))) + (list left-bracket) + (let ((math-compose-level (1+ math-compose-level))) + (math-compose-row-aux (cdr a) rlen)) + (if last (list right-bracket) (list right-bracket comma " ")) + (if nobreak nil (list `(break ,math-compose-level)))))) + + +(defun math-compose-row-aux (a count) + "A -- list of elements, COUNT -- how many elems before ellipsis; does not +put brackets around" + (if (cdr a) + (if (<= count 0) + (if (< count 0) + (math-compose-row-aux (cdr a) -1) + (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...") + comma) + (math-compose-row-aux (cdr a) -1))) + (cons (list 'horiz + (math-compose-expr (car a) vector-prec) + comma) + (math-compose-row-aux (cdr a) (1- count)))) + (list (math-compose-expr (car a) vector-prec)))) + (defun math-compose-rows (a count first) (if (cdr a) (if (<= count 0) diff -u /home/emacsoft/calc-cvs/calc-poly.el /home/luk/calc-cvs/calc-poly.el --- /home/emacsoft/calc-cvs/calc-poly.el 2003-08-01 19:02:10.000000000 +0200 +++ /home/luk/calc-cvs/calc-poly.el 2003-08-02 13:54:45.000000000 +0200 @@ -994,29 +994,38 @@ (- (nth 2 (car fp)) rpt)))) rpt (1- rpt))))) - (setq eqns (math-div (cons 'vec (math-padded-polynomial r var tdeg)) - (math-transpose - (cons 'vec - (mapcar - (function - (lambda (x) - (cons 'vec (math-padded-polynomial - x var tdeg)))) - (cdr eqns)))))) - (and (math-vectorp eqns) - (let ((res 0) - (num nil)) - (setq eqns (nreverse eqns)) - (while eqns - (setq num (cons (car eqns) num) - eqns (cdr eqns)) - (if (car dlist) - (setq num (math-build-polynomial-expr - (nreverse num) var) - res (math-add res (math-div num (car dlist))) - num nil)) - (setq dlist (cdr dlist))) - (math-normalize res))))))) + (let ((p (math-is-polynomial r var tdeg))) + (cond + (p ;it is a polynomial in var + (setq eqns (math-div (cons 'vec ;inline math-padded-polynomial r + (append p + (make-list + (- tdeg (length p)) 0))) + (math-transpose + (cons 'vec + (mapcar + (function + (lambda (x) + (cons 'vec + (math-padded-polynomial + x var tdeg)))) + (cdr eqns)))))) + (and (math-vectorp eqns) + (let ((res 0) + (num nil)) + (setq eqns (nreverse eqns)) + (while eqns + (setq num (cons (car eqns) num) + eqns (cdr eqns)) + (if (car dlist) + (setq num (math-build-polynomial-expr + (nreverse num) var) + res (math-add res (math-div num (car dlist))) + num nil)) + (setq dlist (cdr dlist))) + (math-normalize res)))) + (t + (math-reject-arg expr "Expected a rational function"))))))))