313 |
(calc-slow-wrapper |
(calc-slow-wrapper |
314 |
(let ((expr (calc-top-n 1)) |
(let ((expr (calc-top-n 1)) |
315 |
(uoldname nil) |
(uoldname nil) |
316 |
unew) |
unew |
317 |
|
units) |
318 |
(unless (math-units-in-expr-p expr t) |
(unless (math-units-in-expr-p expr t) |
319 |
(let ((uold (or old-units |
(let ((uold (or old-units |
320 |
(progn |
(progn |
410 |
(calc-enter-result 1 "rmun" (math-simplify-units |
(calc-enter-result 1 "rmun" (math-simplify-units |
411 |
(math-extract-units (calc-top-n 1)))))) |
(math-extract-units (calc-top-n 1)))))) |
412 |
|
|
413 |
|
;; The variables calc-num-units and calc-den-units are local to |
414 |
|
;; calc-explain-units, but are used by calc-explain-units-rec, |
415 |
|
;; which is called by calc-explain-units. |
416 |
|
(defvar calc-num-units) |
417 |
|
(defvar calc-den-units) |
418 |
|
|
419 |
(defun calc-explain-units () |
(defun calc-explain-units () |
420 |
(interactive) |
(interactive) |
421 |
(calc-wrapper |
(calc-wrapper |
422 |
(let ((num-units nil) |
(let ((calc-num-units nil) |
423 |
(den-units nil)) |
(calc-den-units nil)) |
424 |
(calc-explain-units-rec (calc-top-n 1) 1) |
(calc-explain-units-rec (calc-top-n 1) 1) |
425 |
(and den-units (string-match "^[^(].* .*[^)]$" den-units) |
(and calc-den-units (string-match "^[^(].* .*[^)]$" calc-den-units) |
426 |
(setq den-units (concat "(" den-units ")"))) |
(setq calc-den-units (concat "(" calc-den-units ")"))) |
427 |
(if num-units |
(if calc-num-units |
428 |
(if den-units |
(if calc-den-units |
429 |
(message "%s per %s" num-units den-units) |
(message "%s per %s" calc-num-units calc-den-units) |
430 |
(message "%s" num-units)) |
(message "%s" calc-num-units)) |
431 |
(if den-units |
(if calc-den-units |
432 |
(message "1 per %s" den-units) |
(message "1 per %s" calc-den-units) |
433 |
(message "No units in expression")))))) |
(message "No units in expression")))))) |
434 |
|
|
435 |
(defun calc-explain-units-rec (expr pow) |
(defun calc-explain-units-rec (expr pow) |
470 |
(setq name (concat name "^" |
(setq name (concat name "^" |
471 |
(math-format-number (math-abs pow)))))) |
(math-format-number (math-abs pow)))))) |
472 |
(if (math-posp pow) |
(if (math-posp pow) |
473 |
(setq num-units (if num-units |
(setq calc-num-units (if calc-num-units |
474 |
(concat num-units " " name) |
(concat calc-num-units " " name) |
475 |
name)) |
name)) |
476 |
(setq den-units (if den-units |
(setq calc-den-units (if calc-den-units |
477 |
(concat den-units " " name) |
(concat calc-den-units " " name) |
478 |
name)))) |
name)))) |
479 |
(cond ((eq (car-safe expr) '*) |
(cond ((eq (car-safe expr) '*) |
480 |
(calc-explain-units-rec (nth 1 expr) pow) |
(calc-explain-units-rec (nth 1 expr) pow) |
622 |
(save-buffer)))) |
(save-buffer)))) |
623 |
|
|
624 |
|
|
625 |
|
;; The variable math-cu-unit-list is local to math-build-units-table, |
626 |
|
;; but is used by math-compare-unit-names, which is called (indirectly) |
627 |
|
;; by math-build-units-table. |
628 |
|
;; math-cu-unit-list is also local to math-convert-units, but is used |
629 |
|
;; by math-convert-units-rec, which is called by math-convert-units. |
630 |
|
(defvar math-cu-unit-list) |
631 |
|
|
632 |
(defun math-build-units-table () |
(defun math-build-units-table () |
633 |
(or math-units-table |
(or math-units-table |
634 |
(let* ((combined-units (append math-additional-units |
(let* ((combined-units (append math-additional-units |
635 |
math-standard-units)) |
math-standard-units)) |
636 |
(unit-list (mapcar 'car combined-units)) |
(math-cu-unit-list (mapcar 'car combined-units)) |
637 |
tab) |
tab) |
638 |
(message "Building units table...") |
(message "Building units table...") |
639 |
(setq math-units-table-buffer-valid nil) |
(setq math-units-table-buffer-valid nil) |
659 |
(message "Building units table...done") |
(message "Building units table...done") |
660 |
(setq math-units-table tab)))) |
(setq math-units-table tab)))) |
661 |
|
|
662 |
|
;; The variables math-fbu-base and math-fbu-entry are local to |
663 |
|
;; math-find-base-units, but are used by math-find-base-units-rec, |
664 |
|
;; which is called by math-find-base-units. |
665 |
|
(defvar math-fbu-base) |
666 |
|
(defvar math-fbu-entry) |
667 |
|
|
668 |
(defun math-find-base-units (entry) |
(defun math-find-base-units (entry) |
669 |
(if (eq (nth 4 entry) 'boom) |
(if (eq (nth 4 entry) 'boom) |
670 |
(error "Circular definition involving unit %s" (car entry))) |
(error "Circular definition involving unit %s" (car entry))) |
686 |
base))) |
base))) |
687 |
|
|
688 |
(defun math-compare-unit-names (a b) |
(defun math-compare-unit-names (a b) |
689 |
(memq (car b) (cdr (memq (car a) unit-list)))) |
(memq (car b) (cdr (memq (car a) math-cu-unit-list)))) |
690 |
|
|
691 |
(defun math-find-base-units-rec (expr pow) |
(defun math-find-base-units-rec (expr pow) |
692 |
(let ((u (math-check-unit-name expr))) |
(let ((u (math-check-unit-name expr))) |
770 |
(assq (intern (substring name 3)) |
(assq (intern (substring name 3)) |
771 |
math-units-table)))))))) |
math-units-table)))))))) |
772 |
|
|
773 |
|
;; The variable math-which-standard is local to math-to-standard-units, |
774 |
|
;; but is used by math-to-standard-rec, which is called by |
775 |
|
;; math-to-standard-units. |
776 |
|
(defvar math-which-standard) |
777 |
|
|
778 |
(defun math-to-standard-units (expr which-standard) |
(defun math-to-standard-units (expr math-which-standard) |
779 |
(math-to-standard-rec expr)) |
(math-to-standard-rec expr)) |
780 |
|
|
781 |
(defun math-to-standard-rec (expr) |
(defun math-to-standard-rec (expr) |
786 |
(progn |
(progn |
787 |
(if (nth 1 u) |
(if (nth 1 u) |
788 |
(setq expr (math-to-standard-rec (nth 1 u))) |
(setq expr (math-to-standard-rec (nth 1 u))) |
789 |
(let ((st (assq (car u) which-standard))) |
(let ((st (assq (car u) math-which-standard))) |
790 |
(if st |
(if st |
791 |
(setq expr (nth 1 st)) |
(setq expr (nth 1 st)) |
792 |
(setq expr (list 'var (car u) |
(setq expr (list 'var (car u) |
865 |
unit nil)) |
unit nil)) |
866 |
t))) |
t))) |
867 |
|
|
868 |
|
;; The variable math-fcu-u is local to math-find-compatible-unit, |
869 |
|
;; but is used by math-find-compatible-rec which is called by |
870 |
|
;; math-find-compatible-unit. |
871 |
|
(defvar math-fcu-u) |
872 |
|
|
873 |
(defun math-find-compatible-unit (expr unit) |
(defun math-find-compatible-unit (expr unit) |
874 |
(let ((u (math-check-unit-name unit))) |
(let ((math-fcu-u (math-check-unit-name unit))) |
875 |
(if u |
(if math-fcu-u |
876 |
(math-find-compatible-unit-rec expr 1)))) |
(math-find-compatible-unit-rec expr 1)))) |
877 |
|
|
878 |
(defun math-find-compatible-unit-rec (expr pow) |
(defun math-find-compatible-unit-rec (expr pow) |
887 |
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr)))) |
(math-find-compatible-unit-rec (nth 1 expr) (* pow (nth 2 expr)))) |
888 |
(t |
(t |
889 |
(let ((u2 (math-check-unit-name expr))) |
(let ((u2 (math-check-unit-name expr))) |
890 |
(if (equal (nth 4 u) (nth 4 u2)) |
(if (equal (nth 4 math-fcu-u) (nth 4 u2)) |
891 |
(cons expr pow)))))) |
(cons expr pow)))))) |
892 |
|
|
893 |
(defun math-convert-units (expr new-units &optional pure) |
;; The variables math-cu-new-units and math-cu-pure are local to |
894 |
|
;; math-convert-units, but are used by math-convert-units-rec, |
895 |
|
;; which is called by math-convert-units. |
896 |
|
(defvar math-cu-new-units) |
897 |
|
(defvar math-cu-pure) |
898 |
|
|
899 |
|
(defun math-convert-units (expr math-cu-new-units &optional math-cu-pure) |
900 |
(math-with-extra-prec 2 |
(math-with-extra-prec 2 |
901 |
(let ((compat (and (not pure) (math-find-compatible-unit expr new-units))) |
(let ((compat (and (not math-cu-pure) |
902 |
(unit-list nil) |
(math-find-compatible-unit expr math-cu-new-units))) |
903 |
|
(math-cu-unit-list nil) |
904 |
(math-combining-units nil)) |
(math-combining-units nil)) |
905 |
(if compat |
(if compat |
906 |
(math-simplify-units |
(math-simplify-units |
907 |
(math-mul (math-mul (math-simplify-units |
(math-mul (math-mul (math-simplify-units |
908 |
(math-div expr (math-pow (car compat) |
(math-div expr (math-pow (car compat) |
909 |
(cdr compat)))) |
(cdr compat)))) |
910 |
(math-pow new-units (cdr compat))) |
(math-pow math-cu-new-units (cdr compat))) |
911 |
(math-simplify-units |
(math-simplify-units |
912 |
(math-to-standard-units |
(math-to-standard-units |
913 |
(math-pow (math-div (car compat) new-units) |
(math-pow (math-div (car compat) math-cu-new-units) |
914 |
(cdr compat)) |
(cdr compat)) |
915 |
nil)))) |
nil)))) |
916 |
(when (setq unit-list (math-decompose-units new-units)) |
(when (setq math-cu-unit-list (math-decompose-units math-cu-new-units)) |
917 |
(setq new-units (nth 2 (car unit-list)))) |
(setq math-cu-new-units (nth 2 (car math-cu-unit-list)))) |
918 |
(when (eq (car-safe expr) '+) |
(when (eq (car-safe expr) '+) |
919 |
(setq expr (math-simplify-units expr))) |
(setq expr (math-simplify-units expr))) |
920 |
(if (math-units-in-expr-p expr t) |
(if (math-units-in-expr-p expr t) |
921 |
(math-convert-units-rec expr) |
(math-convert-units-rec expr) |
922 |
(math-apply-units (math-to-standard-units |
(math-apply-units (math-to-standard-units |
923 |
(list '/ expr new-units) nil) |
(list '/ expr math-cu-new-units) nil) |
924 |
new-units unit-list pure)))))) |
math-cu-new-units math-cu-unit-list math-cu-pure)))))) |
925 |
|
|
926 |
(defun math-convert-units-rec (expr) |
(defun math-convert-units-rec (expr) |
927 |
(if (math-units-in-expr-p expr nil) |
(if (math-units-in-expr-p expr nil) |
928 |
(math-apply-units (math-to-standard-units (list '/ expr new-units) nil) |
(math-apply-units (math-to-standard-units |
929 |
new-units unit-list pure) |
(list '/ expr math-cu-new-units) nil) |
930 |
|
math-cu-new-units math-cu-unit-list math-cu-pure) |
931 |
(if (Math-primp expr) |
(if (Math-primp expr) |
932 |
expr |
expr |
933 |
(cons (car expr) |
(cons (car expr) |
1062 |
(setcar unitp pname) |
(setcar unitp pname) |
1063 |
math-simplify-expr))))))) |
math-simplify-expr))))))) |
1064 |
|
|
1065 |
|
(defvar math-try-cancel-units) |
1066 |
|
|
1067 |
(math-defsimplify / |
(math-defsimplify / |
1068 |
(and math-simplifying-units |
(and math-simplifying-units |
1069 |
(let ((np (cdr math-simplify-expr)) |
(let ((np (cdr math-simplify-expr)) |
1070 |
(try-cancel-units 0) |
(math-try-cancel-units 0) |
1071 |
n nn) |
n nn) |
1072 |
(setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) |
(setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) |
1073 |
(cdr (nth 2 math-simplify-expr)) |
(cdr (nth 2 math-simplify-expr)) |
1082 |
(math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) |
(math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) |
1083 |
(setq np (cdr (cdr n)))) |
(setq np (cdr (cdr n)))) |
1084 |
(math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) |
(math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) |
1085 |
(if (eq try-cancel-units 0) |
(if (eq math-try-cancel-units 0) |
1086 |
(let* ((math-simplifying-units nil) |
(let* ((math-simplifying-units nil) |
1087 |
(base (math-simplify |
(base (math-simplify |
1088 |
(math-to-standard-units math-simplify-expr nil)))) |
(math-to-standard-units math-simplify-expr nil)))) |
1127 |
(setq ud1 ud) |
(setq ud1 ud) |
1128 |
(while ud1 |
(while ud1 |
1129 |
(and (eq (car (car un)) (car (car ud1))) |
(and (eq (car (car un)) (car (car ud1))) |
1130 |
(setq try-cancel-units |
(setq math-try-cancel-units |
1131 |
(+ try-cancel-units |
(+ math-try-cancel-units |
1132 |
(- (* (cdr (car un)) pow1) |
(- (* (cdr (car un)) pow1) |
1133 |
(* (cdr (car ud)) pow2))))) |
(* (cdr (car ud)) pow2))))) |
1134 |
(setq ud1 (cdr ud1))) |
(setq ud1 (cdr ud1))) |