summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorJay Belanger <jay.p.belanger@gmail.com>2011-01-23 23:08:04 -0600
committerJay Belanger <jay.p.belanger@gmail.com>2011-01-23 23:08:04 -0600
commit603823f5b7759118ff542a37a1c03e772a89853d (patch)
tree0493fa76f3f5901ae396f33742319c4dcbc1fda7 /lisp
parentc517fb38cdd6721853625ecd737f7e551a28f294 (diff)
downloademacs-603823f5b7759118ff542a37a1c03e772a89853d.tar.gz
* 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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog16
-rw-r--r--lisp/calc/calc-ext.el12
-rw-r--r--lisp/calc/calc-help.el9
-rw-r--r--lisp/calc/calc-units.el123
-rw-r--r--lisp/calc/calc.el13
5 files changed, 168 insertions, 5 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f027685ab5a..0bbe6765ec3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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,
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 0da423a8eac..79d60303bb2 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -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-store-value calc-var-name)
("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-full-help calc-g-prefix-help calc-help-prefix
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-convert-temperature calc-convert-units calc-define-unit
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
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 847eccf658f..14d292dd164 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -663,12 +663,19 @@ C-w Describe how there is no warranty for Calc."
(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)
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index cab4c1f8e4c..f7987d064c2 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -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 @@ If EXPR is nil, return nil."
(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 @@ If EXPR is nil, return nil."
(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:
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index d99f164e974..6e191c9cdd7 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -435,6 +435,19 @@ by displaying the sub-formula in `calc-selected-face'."
: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))