Mercurial > emacs
changeset 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 | b8a360ee54f1 |
| children | |
| files | lisp/ChangeLog lisp/calc/calc-ext.el lisp/calc/calc-help.el lisp/calc/calc-units.el lisp/calc/calc.el |
| diffstat | 5 files changed, 168 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sun Jan 23 20:55:10 2011 -0800 +++ b/lisp/ChangeLog Sun Jan 23 23:08:04 2011 -0600 @@ -1,3 +1,19 @@ +2011-01-24 Jay Belanger <jay.p.belanger@gmail.com> + + * 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. + 2011-01-22 Glenn Morris <rgm@gnu.org> * emacs-lisp/copyright.el (copyright-find-copyright): New function,
--- a/lisp/calc/calc-ext.el Sun Jan 23 20:55:10 2011 -0800 +++ b/lisp/calc/calc-ext.el Sun Jan 23 23:08:04 2011 -0600 @@ -547,6 +547,10 @@ (define-key calc-mode-map "ud" 'calc-define-unit) (define-key calc-mode-map "ue" 'calc-explain-units) (define-key calc-mode-map "ug" 'calc-get-unit-definition) + (define-key calc-mode-map "ul+" 'calc-luplus) + (define-key calc-mode-map "ul-" 'calc-luminus) + (define-key calc-mode-map "ull" 'calc-level) + (define-key calc-mode-map "ul?" 'calc-ul-prefix-help) (define-key calc-mode-map "up" 'calc-permanent-units) (define-key calc-mode-map "ur" 'calc-remove-units) (define-key calc-mode-map "us" 'calc-simplify-units) @@ -930,7 +934,8 @@ ("calc-stuff" calc-explain-why calcFunc-clean calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) - ("calc-units" calcFunc-usimplify + ("calc-units" calcFunc-usimplify calcFunc-luplus +calcFunc-luminus calcFunc-fieldlevel calcFunc-powerlevel math-build-units-table math-build-units-table-buffer math-check-unit-name math-convert-temperature math-convert-units math-extract-units math-remove-units math-simplify-units @@ -1047,7 +1052,8 @@ calc-hyperbolic-prefix-help calc-inv-hyp-prefix-help calc-option-prefix-help calc-inverse-prefix-help calc-j-prefix-help calc-k-prefix-help calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help -calc-t-prefix-help calc-u-prefix-help calc-v-prefix-help) +calc-t-prefix-help calc-u-prefix-help calc-ul-prefix-help +calc-v-prefix-help) ("calc-incom" calc-begin-complex calc-begin-vector calc-comma calc-dots calc-end-complex calc-end-vector calc-semi) @@ -1161,7 +1167,7 @@ calc-enter-units-table calc-explain-units calc-extract-units calc-get-unit-definition calc-permanent-units calc-quick-units calc-remove-units calc-simplify-units calc-undefine-unit -calc-view-units-table) +calc-view-units-table calc-luplus calc-luminus calc-level) ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm calc-conj-transpose calc-cons calc-cross calc-kron calc-diag
--- a/lisp/calc/calc-help.el Sun Jan 23 20:55:10 2011 -0800 +++ b/lisp/calc/calc-help.el Sun Jan 23 23:08:04 2011 -0600 @@ -663,12 +663,19 @@ (calc-do-prefix-help '("Simplify, Convert, Temperature-convert, Base-units" "Autorange; Remove, eXtract; Explain; View-table; 0-9" - "Define, Undefine, Get-defn, Permanent" + "Define, Undefine, Get-defn, Permanent, Logarithmic" "SHIFT + View-table-other-window" "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN" "SHIFT + stat: + (sum), - (asum), * (prod), # (count)") "units/stat" ?u)) +(defun calc-ul-prefix-help () + (interactive) + (if (eq this-command last-command) + (message "ul-") + (message "logarithmic-units: + (logarithmic), - (logarithmic), Level: ul-")) + (push ?l unread-command-events) + (push ?u unread-command-events)) (defun calc-v-prefix-help () (interactive)
--- 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:
--- a/lisp/calc/calc.el Sun Jan 23 20:55:10 2011 -0800 +++ b/lisp/calc/calc.el Sun Jan 23 23:08:04 2011 -0600 @@ -435,6 +435,19 @@ :group 'calc :type 'boolean) +(defcustom calc-default-field-reference-level + "20 uPa" + "The default reference level for logarithmic units (field)." + :group 'calc + :type '(string)) + +(defcustom calc-default-power-reference-level + "mW" + "The default reference level for logarithmic units (power)." + :group 'calc + :type '(string)) + + (defface calc-nonselected-face '((t :inherit shadow :slant italic))