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))