Calc: Big Lang matrix display, `apart' bug fix

Calc: Big Lang matrix display, `apart' bug fix

[Lukasz Stafiniak]

[-- 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

any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix)

[D. Goel]

Lukasz (the new calc maintainer) has asked me to apply this calc patch
since his CVS is not working correctly.

I am now knowledgable about what Lukasz has done here.  Do any calc
gurus/enthusiasts have any comments/objections before I apply this
patch?

Lukasz, can you please describe in english what your patch does?


DG                                 http://gnufans.net/~deego/
--

Re: any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix)

[Lukasz Stafiniak]

>
> Lukasz (the new calc maintainer) has asked me to apply this calc patch
> since his CVS is not working correctly.
>
> I am now knowledgable about what Lukasz has done here.  Do any calc
> gurus/enthusiasts have any comments/objections before I apply this
> patch?
>
> Lukasz, can you please describe in english what your patch does?
>
>
> DG                                 http://gnufans.net/~deego/
> --

It is really a little thing.

First, matrix display in Big Language mode:

  Before, entries to the matrix were actually printed in Flat Language

  Now, they are printed in Big Language, with vertical boxes expanded to the
size of the highest expression in a row

Second, `apart' bug fix:

  Before, inside `math-partial-fractions', `math-padded-polynomial'
calculated the polynomial representation of the remainder using
`math-is-polynomial' and not taking into consideration, that the last one
might return nil

  After, I inlined `math-padded-polynomial' to compute `math-is-polynomial'
and in case the latter returns nil, report an error "Expected a rational
function".

Best wishes,
Lukasz

Re: any comments before i apply patch?

[D. Goel]

D. Goel <deego@gnufans.org> writes:

>
> I am now knowledgable about what Lukasz has done here.  

sorry i meant: I am *not* knowledgable about what Lukasz has done
here.   :-) 


[...]