* Calc: Big Lang matrix display, `apart' bug fix
@ 2003-08-15 18:40 Lukasz Stafiniak
2003-08-22 19:03 ` any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix) D. Goel
0 siblings, 1 reply; 4+ messages in thread
From: Lukasz Stafiniak @ 2003-08-15 18:40 UTC (permalink / 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
^ permalink raw reply [flat|nested] 4+ messages in thread* any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix)
2003-08-15 18:40 Calc: Big Lang matrix display, `apart' bug fix Lukasz Stafiniak
@ 2003-08-22 19:03 ` D. Goel
2003-08-23 16:27 ` Lukasz Stafiniak
2003-08-23 16:47 ` any comments before i apply patch? D. Goel
0 siblings, 2 replies; 4+ messages in thread
From: D. Goel @ 2003-08-22 19:03 UTC (permalink / raw)
Cc: emacs-devel
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/
--
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: any comments before i apply patch? (was: Re: Calc: Big Lang matrix display, `apart' bug fix)
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
1 sibling, 0 replies; 4+ messages in thread
From: Lukasz Stafiniak @ 2003-08-23 16:27 UTC (permalink / raw)
Cc: emacs-devel
>
> 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
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: any comments before i apply patch?
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 ` D. Goel
1 sibling, 0 replies; 4+ messages in thread
From: D. Goel @ 2003-08-23 16:47 UTC (permalink / raw)
Cc: emacs-devel
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. :-)
[...]
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2003-08-23 16:47 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2003-08-15 18:40 Calc: Big Lang matrix display, `apart' bug fix Lukasz Stafiniak
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
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).