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.

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