From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: "Lukasz Stafiniak" Newsgroups: gmane.emacs.devel Subject: Calc: Big Lang matrix display, `apart' bug fix Date: Fri, 15 Aug 2003 20:40:35 +0200 Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <000201c125d6$115e3420$9aee4dd5@ppp> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0007_01C3636D.7AD0DF80" X-Trace: sea.gmane.org 1061040937 22428 80.91.224.253 (16 Aug 2003 13:35:37 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 16 Aug 2003 13:35:37 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Sat Aug 16 15:35:36 2003 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 19o1DU-0000q7-00 for ; Sat, 16 Aug 2003 15:35:36 +0200 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 19o1Ex-00031g-00 for ; Sat, 16 Aug 2003 15:37:07 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.20) id 19o1D6-0006rR-8x for emacs-devel@quimby.gnus.org; Sat, 16 Aug 2003 09:35:12 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.20) id 19o1Cx-0006rJ-EK for emacs-devel@gnu.org; Sat, 16 Aug 2003 09:35:03 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.20) id 19o1CQ-0005ZW-Tw for emacs-devel@gnu.org; Sat, 16 Aug 2003 09:35:02 -0400 Original-Received: from [212.77.101.161] (helo=smtp.wp.pl) by monty-python.gnu.org with esmtp (Exim 4.20) id 19o1CQ-0005ZJ-BZ for emacs-devel@gnu.org; Sat, 16 Aug 2003 09:34:30 -0400 Original-Received: (WP-SMTPD 13789 invoked from network); 16 Aug 2003 13:34:27 -0000 Original-Received: from pb154.legnica.cvx.ppp.tpnet.pl (HELO ppp) (luk_stafi@[213.77.238.154]) (envelope-sender ) by smtp.wp.pl (wp-smtpd) with SMTP for ; 16 Aug 2003 13:34:25 -0000 Original-To: X-Priority: 3 X-MSMail-Priority: Normal X-Mailer: Microsoft Outlook Express 5.50.4133.2400 X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4133.2400 X-AntiVirus: skaner antywirusowy poczty Wirtualnej Polski S. A. X-WP-ChangeAV: 0 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:15977 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:15977 This is a multi-part message in MIME format. ------=_NextPart_000_0007_01C3636D.7AD0DF80 Content-Type: text/plain; charset="iso-8859-2" Content-Transfer-Encoding: 7bit Hi, Anyone using Calc, Could you take a look at this little thing. Thanks, Lukasz Stafiniak ------=_NextPart_000_0007_01C3636D.7AD0DF80 Content-Type: text/plain; name="calcdiff.txt" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="calcdiff.txt" diff -u /home/emacsoft/calc-cvs/calccomp.el = /home/luk/calc-cvs/calccomp.el=0A= --- /home/emacsoft/calc-cvs/calccomp.el 2003-08-01 19:09:54.000000000 = +0200=0A= +++ /home/luk/calc-cvs/calccomp.el 2003-08-02 14:44:40.000000000 +0200=0A= @@ -170,7 +170,7 @@=0A= ((eq calc-matrix-just 'center) 'vcent)=0A= (t 'vleft)))=0A= (break calc-break-vectors))=0A= - (if (and (memq calc-language '(nil big))=0A= + (if (and (eq calc-language nil)=0A= (not calc-break-vectors)=0A= (math-matrixp a) (not (math-matrixp (nth 1 a)))=0A= (or calc-full-vectors=0A= @@ -228,6 +228,96 @@=0A= (concat=0A= " "=0A= right-bracket)))))))))=0A= + (if (and (eq calc-language 'big)=0A= + (not calc-break-vectors)=0A= + (math-matrixp a) (not (math-matrixp (nth 1 a)))=0A= + (or calc-full-vectors=0A= + (and (< (length a) 7) (< (length (nth 1 a)) 7))=0A= + (progn (setq break t) nil)))=0A= + (if (progn=0A= + (setq vector-prec (if (or (and calc-vector-commas=0A= + (math-vector-no-parens=0A= + (nth 1 a)))=0A= + (memq 'P calc-matrix-brackets))=0A= + 0 1000))=0A= + (=3D (length a) 2))=0A= + (list 'horiz=0A= + (concat left-bracket left-bracket " ")=0A= + (math-compose-vector (cdr (nth 1 a))=0A= + (concat comma " ")=0A= + vector-prec)=0A= + (concat " " right-bracket right-bracket))=0A= + (let* ((rows (1- (length a)))=0A= + (cols (1- (length (nth 1 a))))=0A= +=0A= + (matasc =0A= + (mapcar (lambda (r) (mapcar=0A= + (lambda (e) (calcFunc-cascent e))=0A= + (cdr r))) (cdr a)))=0A= + (rowasc (mapcar (lambda (r) (apply 'max r)) matasc))=0A= + (matdesc=0A= + (mapcar (lambda (r) (mapcar=0A= + (lambda (e) (calcFunc-cdescent e))=0A= + (cdr r))) (cdr a)))=0A= + (rowdesc (mapcar (lambda (r) (apply 'max r)) matdesc))=0A= + (basepos (+ (- (/ rows 2) (- 1 (% rows 2))) ;blanks=0A= + (let ((res 0) i (auxa rowasc) (auxd rowdesc))=0A= + (progn=0A= + (dotimes (i (/ rows 2) res)=0A= + (setq res (+ res (car auxa) (car auxd)))=0A= + (setq auxa (cdr auxa) auxd (cdr auxd)))=0A= + (if (eq (% rows 2) 1)=0A= + (+ res (1- (car auxa))) res)=0A= + ))))=0A= + )=0A= + `(horiz (vleft=0A= + ,basepos=0A= + ,@(make-list (1- (car rowasc)) '(rule ? ))=0A= + ,(concat=0A= + (and outer-brackets (concat left-bracket " "))=0A= + (and inner-brackets (concat left-bracket " ")))=0A= + ,@(make-list (car rowdesc) '(rule ? ))=0A= + ,@(apply 'append (mapcar* (lambda (asc desc)=0A= + (append=0A= + ;includes blank=0A= + (make-list asc '(rule ? ))=0A= + (list (concat (and outer-brackets=0A= + " ")=0A= + (and inner-brackets=0A= + (concat left-bracket " "))))=0A= + (make-list desc '(rule ? ))=0A= + ))=0A= + (cdr rowasc) (cdr rowdesc))))=0A= +=0A= + ,@(math-compose-big-matrix (cdr a) 1 cols basepos=0A= + matasc rowasc matdesc rowdesc)=0A= + (vleft=0A= + ,basepos=0A= + ,@(let ((res)) (while (cdr rowasc)=0A= + (setq res=0A= + (append res=0A= + (make-list (1- (car rowasc)) '(rule ? ))=0A= + (list (if inner-brackets=0A= + (concat " " right-bracket=0A= + (and row-commas=0A= + comma))=0A= + (if (and outer-brackets=0A= + row-commas)=0A= + comma "")))=0A= + ;includes blank=0A= + (make-list (1+ (car rowdesc)) '(rule ? ))=0A= + )=0A= + rowasc (cdr rowasc)=0A= + rowdesc (cdr rowdesc))) res)=0A= +=0A= + ,@(make-list (1- (car rowasc)) '(rule ? ))=0A= + ,(concat=0A= + (and inner-brackets=0A= + (concat " " right-bracket))=0A= + (and outer-brackets=0A= + (concat " " right-bracket)))=0A= + ,@(make-list (car rowdesc) '(rule ? ))=0A= + ))))=0A= (if (and calc-display-strings=0A= (cdr a)=0A= (math-vector-is-string a))=0A= @@ -279,7 +369,7 @@=0A= (list 'break math-compose-level)=0A= (math-compose-expr (nth (1- (length a)) a)=0A= (if (equal comma "") 1000 0))=0A= - right-bracket)))))))=0A= + right-bracket))))))))=0A= ((eq (car a) 'incomplete)=0A= (if (cdr (cdr a))=0A= (cond ((eq (nth 1 a) 'vec)=0A= @@ -944,6 +1034,117 @@=0A= res)))=0A= (nreverse res)))=0A= =0A= +(defun math-compose-big-matrix (a col cols base matasc rowasc=0A= + matdesc rowdesc)=0A= + "Compose a big matrix of rows in A and COLS columns, with BASE as = baseline.=0A= +Composition goes column after column."=0A= + (let ((col 0)=0A= + (res nil)=0A= + )=0A= + (while (<=3D (setq col (1+ col)) cols)=0A= + (setq res=0A= + (cons (cons just=0A= + (cons base (apply 'append=0A= + ;same body as in mapcar* below=0A= + (append=0A= + (make-list (- (car rowasc)=0A= + (nth (1- col)=0A= + (car matasc)))=0A= + '(rule ? ))=0A= + (list=0A= + (list 'horiz (math-compose-expr=0A= + (nth col (car a))=0A= + vector-prec)=0A= + (if (=3D col cols)=0A= + ""=0A= + (concat=0A= + (or calc-vector-commas=0A= + " ") " "))))=0A= + (make-list (- (car=0A= + rowdesc)=0A= + (nth (1- col)=0A= + (car matdesc)))=0A= + '(rule ? ))=0A= + )=0A= + =0A= + (mapcar* ;(function=0A= + (lambda (r rasc rdesc asc desc)=0A= + (append=0A= + ;includes blank=0A= + (make-list (1+ (- asc (nth (1-=0A= + col)=0A= + rasc)))=0A= + '(rule ? ))=0A= + (list=0A= + (list 'horiz (math-compose-expr=0A= + (nth col r)=0A= + vector-prec)=0A= + (if (=3D col cols)=0A= + ""=0A= + (concat=0A= + (or calc-vector-commas=0A= + " ") " "))))=0A= + (make-list (- desc (nth=0A= + (1- col)=0A= + rdesc) )=0A= + '(rule ? ))=0A= + ));)=0A= + (cdr a) (cdr matasc) (cdr=0A= + matdesc)=0A= + (cdr rowasc) (cdr rowdesc)))))=0A= + res)))=0A= + (nreverse res)))=0A= +=0A= +=0A= +(defun math-compose-matrix-flat (a count first)=0A= + (if (cdr a)=0A= + (if (<=3D count 0)=0A= + (if (< count 0)=0A= + (math-compose-matrix-flat (cdr a) -1 nil)=0A= + (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")=0A= + comma)=0A= + (cons (list 'break math-compose-level)=0A= + (math-compose-matrix-flat (cdr a) -1 nil))))=0A= + (append (if first (list=0A= + 'horiz (list 'set math-compose-level=0A= + (length left-bracket))=0A= + left-bracket) nil)=0A= + (cons (math-compose-row (car a) nil)=0A= + (math-compose-matrix-flat (cdr a) (1- count) nil))))=0A= + (append (if first (list=0A= + 'horiz (list 'set math-compose-level=0A= + (length left-bracket)) left-bracket) nil)=0A= + (list (math-compose-row (car a) t t)=0A= + right-bracket))=0A= +))=0A= +=0A= +(defun math-compose-row (a nobreak &optional last)=0A= + "Composes a complete row of a matrix."=0A= + (let ((rlen (if (or calc-full-vectors (< (length a) 7)) (length a) = 3)))=0A= + (append (list 'horiz (list 'set (1+ math-compose-level)))=0A= + (list left-bracket) =0A= + (let ((math-compose-level (1+ math-compose-level)))=0A= + (math-compose-row-aux (cdr a) rlen))=0A= + (if last (list right-bracket) (list right-bracket comma " "))=0A= + (if nobreak nil (list `(break ,math-compose-level))))))=0A= +=0A= +=0A= +(defun math-compose-row-aux (a count)=0A= + "A -- list of elements, COUNT -- how many elems before ellipsis; does = not=0A= +put brackets around"=0A= + (if (cdr a)=0A= + (if (<=3D count 0)=0A= + (if (< count 0)=0A= + (math-compose-row-aux (cdr a) -1)=0A= + (cons (concat (if (eq calc-language 'tex) " \\ldots" " ...")=0A= + comma)=0A= + (math-compose-row-aux (cdr a) -1)))=0A= + (cons (list 'horiz=0A= + (math-compose-expr (car a) vector-prec)=0A= + comma)=0A= + (math-compose-row-aux (cdr a) (1- count))))=0A= + (list (math-compose-expr (car a) vector-prec))))=0A= +=0A= (defun math-compose-rows (a count first)=0A= (if (cdr a)=0A= (if (<=3D count 0)=0A= diff -u /home/emacsoft/calc-cvs/calc-poly.el = /home/luk/calc-cvs/calc-poly.el=0A= --- /home/emacsoft/calc-cvs/calc-poly.el 2003-08-01 19:02:10.000000000 = +0200=0A= +++ /home/luk/calc-cvs/calc-poly.el 2003-08-02 13:54:45.000000000 +0200=0A= @@ -994,29 +994,38 @@=0A= (- (nth 2 (car fp))=0A= rpt))))=0A= rpt (1- rpt)))))=0A= - (setq eqns (math-div (cons 'vec (math-padded-polynomial r var tdeg))=0A= - (math-transpose=0A= - (cons 'vec=0A= - (mapcar=0A= - (function=0A= - (lambda (x)=0A= - (cons 'vec (math-padded-polynomial=0A= - x var tdeg))))=0A= - (cdr eqns))))))=0A= - (and (math-vectorp eqns)=0A= - (let ((res 0)=0A= - (num nil))=0A= - (setq eqns (nreverse eqns))=0A= - (while eqns=0A= - (setq num (cons (car eqns) num)=0A= - eqns (cdr eqns))=0A= - (if (car dlist)=0A= - (setq num (math-build-polynomial-expr=0A= - (nreverse num) var)=0A= - res (math-add res (math-div num (car dlist)))=0A= - num nil))=0A= - (setq dlist (cdr dlist)))=0A= - (math-normalize res)))))))=0A= + (let ((p (math-is-polynomial r var tdeg)))=0A= + (cond=0A= + (p ;it is a polynomial in var=0A= + (setq eqns (math-div (cons 'vec ;inline math-padded-polynomial r=0A= + (append p=0A= + (make-list=0A= + (- tdeg (length p)) 0)))=0A= + (math-transpose=0A= + (cons 'vec=0A= + (mapcar=0A= + (function=0A= + (lambda (x)=0A= + (cons 'vec=0A= + (math-padded-polynomial=0A= + x var tdeg))))=0A= + (cdr eqns))))))=0A= + (and (math-vectorp eqns)=0A= + (let ((res 0)=0A= + (num nil))=0A= + (setq eqns (nreverse eqns))=0A= + (while eqns=0A= + (setq num (cons (car eqns) num)=0A= + eqns (cdr eqns))=0A= + (if (car dlist)=0A= + (setq num (math-build-polynomial-expr=0A= + (nreverse num) var)=0A= + res (math-add res (math-div num (car dlist)))=0A= + num nil))=0A= + (setq dlist (cdr dlist)))=0A= + (math-normalize res))))=0A= + (t=0A= + (math-reject-arg expr "Expected a rational function"))))))))=0A= ------=_NextPart_000_0007_01C3636D.7AD0DF80 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel ------=_NextPart_000_0007_01C3636D.7AD0DF80--