unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: "Lukasz Stafiniak" <luk_stafi@wp.pl>
Subject: Calc: Big Lang matrix display, `apart' bug fix
Date: Fri, 15 Aug 2003 20:40:35 +0200	[thread overview]
Message-ID: <000201c125d6$115e3420$9aee4dd5@ppp> (raw)

[-- Attachment #1: Type: text/plain, Size: 95 bytes --]

Hi,

Anyone using Calc,
Could you take a look at this little thing.

Thanks,
Lukasz Stafiniak


[-- Attachment #2: calcdiff.txt --]
[-- Type: text/plain, Size: 9664 bytes --]

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"))))))))

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/emacs-devel

             reply	other threads:[~2003-08-15 18:40 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2003-08-15 18:40 Lukasz Stafiniak [this message]
2003-08-22 19:03 ` any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix) D. Goel
2003-08-23 16:27   ` Lukasz Stafiniak
2003-08-23 16:47   ` any comments before i apply patch? D. Goel

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='000201c125d6$115e3420$9aee4dd5@ppp' \
    --to=luk_stafi@wp.pl \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).