Mercurial > emacs
diff lisp/calc/calc-units.el @ 112453:06719a229a46 default tip
* calc/calc.el (calc-default-power-reference-level)
(calc-default-field-reference-level): New variables.
* calc/calc-units.el (math-standard-units): Add dB and Np.
(math-logunits): New variable.
(math-extract-logunits, math-logcombine, calcFunc-luplus)
(calcFunc-luminus, calc-luplus, calc-luminus, math-logunit-level)
(calcFunc-fieldlevel, calcFunc-powerlevel, calc-level): New
functions.
(math-find-base-units-rec): Add entry for ln(10).
* calc/calc-help.el (calc-u-prefix-help): Add logarithmic help.
(calc-ul-prefix-help): New function.
* calc/calc-ext.el (calc-init-extensions): Autoload new units
functions. Add keybindings for new units functions.
author | Jay Belanger <jay.p.belanger@gmail.com> |
---|---|
date | Sun, 23 Jan 2011 23:08:04 -0600 |
parents | 61f7601898b1 |
children |
line wrap: on
line diff
--- a/lisp/calc/calc-units.el Sun Jan 23 20:55:10 2011 -0800 +++ b/lisp/calc/calc-units.el Sun Jan 23 23:08:04 2011 -0600 @@ -296,7 +296,10 @@ ( R0 "8.314472 J/(mol K)" "Molar gas constant" nil "8.314472 J/(mol K) (*)") ( V0 "22.710981*10^(-3) m^3/mol" "Standard volume of ideal gas" nil - "22.710981 10^-3 m^3/mol (*)"))) + "22.710981 10^-3 m^3/mol (*)") + ;; Logarithmic units + ( Np nil "*Neper") + ( dB "(ln(10)/20) Np" "decibel"))) (defvar math-additional-units nil @@ -871,6 +874,7 @@ (or (eq (nth 1 expr) 'pi) (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) + ((equal expr '(calcFunc-ln 10))) (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) @@ -1551,6 +1555,123 @@ (pop-to-buffer (get-buffer "*Units Table*")) (display-buffer (get-buffer "*Units Table*"))))) +;;; Logarithmic units functions + +(defvar math-logunits '((var dB var-dB) + (var Np var-Np))) + +(defun math-extract-logunits (expr) + (if (memq (car-safe expr) '(* /)) + (cons (car expr) + (mapcar 'math-extract-logunits (cdr expr))) + (if (memq (car-safe expr) '(^)) + (list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr)) + (if (member expr math-logunits) expr 1)))) + +(defun math-logcombine (a b neg) + (let ((aunit (math-simplify (math-extract-logunits a)))) + (if (not (eq (car-safe aunit) 'var)) + (calc-record-why "*Improper logarithmic unit" aunit) + (let* ((units (math-extract-units a)) + (acoeff (math-simplify (math-remove-units a))) + (bcoeff (math-simplify (math-to-standard-units + (list '/ b units) nil)))) + (if (math-units-in-expr-p bcoeff nil) + (calc-record-why "*Inconsistent units" nil) + (if (and neg + (or (math-lessp acoeff bcoeff) + (math-equal acoeff bcoeff))) + (calc-record-why "*Improper coefficients" nil) + (math-mul + (if (equal aunit '(var dB var-dB)) + (math-mul 10 + (calcFunc-log10 + (if neg + (math-sub + (math-pow 10 (math-div acoeff 10)) + (math-pow 10 (math-div bcoeff 10))) + (math-add + (math-pow 10 (math-div acoeff 10)) + (math-pow 10 (math-div bcoeff 10)))))) + (calcFunc-ln + (if neg + (math-sub + (calcFunc-exp acoeff) + (calcFunc-exp bcoeff)) + (math-add + (calcFunc-exp acoeff) + (calcFunc-exp bcoeff))))) + units))))))) + +(defun calcFunc-luplus (a b) + (math-logcombine a b nil)) + +(defun calcFunc-luminus (a b) + (math-logcombine a b t)) + +(defun calc-luplus (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (calc-binary-op "lu-" 'calcFunc-luminus arg) + (calc-binary-op "lu+" 'calcFunc-luplus arg)))) + +(defun calc-luminus (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (calc-binary-op "lu+" 'calcFunc-luplus arg) + (calc-binary-op "lu-" 'calcFunc-luminus arg)))) + +;(defun calcFunc-lmul (a b) + + +(defun math-logunit-level (val ref power) + (let ((lunit (math-simplify (math-extract-logunits val)))) + (if (not (eq (car-safe lunit) 'var)) + (calc-record-why "*Improper logarithmic unit" lunit) + (if (not (eq 1 (math-simplify (math-extract-units (math-div val lunit))))) + (calc-record-why "*Inappropriate units" nil) + (let ((coeff (math-simplify (math-div val lunit)))) + (if (equal lunit '(var dB var-dB)) + (math-mul + ref + (math-pow + 10 + (math-div + coeff + (if power 10 20)))) + (math-mul + ref + (calcFunc-exp + (if power + (math-mul 2 coeff) + coeff))))))))) + +(defvar calc-default-field-reference-level) +(defvar calc-default-power-reference-level) + +(defun calcFunc-fieldlevel (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-default-field-reference-level))) + (math-logunit-level val ref nil)) + +(defun calcFunc-powerlevel (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-default-power-reference-level))) + (math-logunit-level val ref t)) + +(defun calc-level (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "plvl" 'calcFunc-powerlevel arg) + (calc-unary-op "plvl" 'calcFunc-powerlevel arg)) + (if (calc-is-option) + (calc-binary-op "flvl" 'calcFunc-fieldlevel arg) + (calc-unary-op "flvl" 'calcFunc-fieldlevel arg))))) + (provide 'calc-units) ;; Local variables: