/[emacs]/emacs/lisp/calc/calc-units.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-units.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4.2.3 by miles, Wed Oct 6 05:21:53 2004 UTC revision 1.4.2.4 by miles, Wed Dec 8 23:31:43 2004 UTC
# Line 3  Line 3 
3  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
4    
5  ;; Author: David Gillespie <daveg@synaptics.com>  ;; Author: David Gillespie <daveg@synaptics.com>
6  ;; Maintainers: D. Goel <deego@gnufans.org>  ;; Maintainer: Jay Belanger <belanger@truman.edu>
 ;;              Colin Walters <walters@debian.org>  
7    
8  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
9    
# Line 940  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 939  Entries are (SYMBOL EXPR DOC-STRING TEMP
939      (math-simplify a)))      (math-simplify a)))
940  (defalias 'calcFunc-usimplify 'math-simplify-units)  (defalias 'calcFunc-usimplify 'math-simplify-units)
941    
942    ;; The function created by math-defsimplify uses the variable
943    ;; math-simplify-expr, and so is used by functions in math-defsimplify
944    (defvar math-simplify-expr)
945    
946  (math-defsimplify (+ -)  (math-defsimplify (+ -)
947    (and math-simplifying-units    (and math-simplifying-units
948         (math-units-in-expr-p (nth 1 expr) nil)         (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
949         (let* ((units (math-extract-units (nth 1 expr)))         (let* ((units (math-extract-units (nth 1 math-simplify-expr)))
950                (ratio (math-simplify (math-to-standard-units                (ratio (math-simplify (math-to-standard-units
951                                       (list '/ (nth 2 expr) units) nil))))                                       (list '/ (nth 2 math-simplify-expr) units) nil))))
952           (if (math-units-in-expr-p ratio nil)           (if (math-units-in-expr-p ratio nil)
953               (progn               (progn
954                 (calc-record-why "*Inconsistent units" expr)                 (calc-record-why "*Inconsistent units" math-simplify-expr)
955                 expr)                 math-simplify-expr)
956             (list '* (math-add (math-remove-units (nth 1 expr))             (list '* (math-add (math-remove-units (nth 1 math-simplify-expr))
957                                (if (eq (car expr) '-) (math-neg ratio) ratio))                                (if (eq (car math-simplify-expr) '-)
958                                      (math-neg ratio) ratio))
959                   units)))))                   units)))))
960    
961  (math-defsimplify *  (math-defsimplify *
# Line 960  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 964  Entries are (SYMBOL EXPR DOC-STRING TEMP
964  (defun math-simplify-units-prod ()  (defun math-simplify-units-prod ()
965    (and math-simplifying-units    (and math-simplifying-units
966         calc-autorange-units         calc-autorange-units
967         (Math-realp (nth 1 expr))         (Math-realp (nth 1 math-simplify-expr))
968         (let* ((num (math-float (nth 1 expr)))         (let* ((num (math-float (nth 1 math-simplify-expr)))
969                (xpon (calcFunc-xpon num))                (xpon (calcFunc-xpon num))
970                (unitp (cdr (cdr expr)))                (unitp (cdr (cdr math-simplify-expr)))
971                (unit (car unitp))                (unit (car unitp))
972                (pow (if (eq (car expr) '*) 1 -1))                (pow (if (eq (car math-simplify-expr) '*) 1 -1))
973                u)                u)
974           (and (eq (car-safe unit) '*)           (and (eq (car-safe unit) '*)
975                (setq unitp (cdr unit)                (setq unitp (cdr unit)
# Line 1015  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1019  Entries are (SYMBOL EXPR DOC-STRING TEMP
1019                       (or (not (eq p pref))                       (or (not (eq p pref))
1020                           (< xpon (+ pxpon (* (math-abs pow) 3))))                           (< xpon (+ pxpon (* (math-abs pow) 3))))
1021                       (progn                       (progn
1022                         (setcar (cdr expr)                         (setcar (cdr math-simplify-expr)
1023                                 (let ((calc-prefer-frac nil))                                 (let ((calc-prefer-frac nil))
1024                                   (calcFunc-scf (nth 1 expr)                                   (calcFunc-scf (nth 1 math-simplify-expr)
1025                                                 (- uxpon pxpon))))                                                 (- uxpon pxpon))))
1026                         (setcar unitp pname)                         (setcar unitp pname)
1027                         expr)))))))                         math-simplify-expr)))))))
1028    
1029  (math-defsimplify /  (math-defsimplify /
1030    (and math-simplifying-units    (and math-simplifying-units
1031         (let ((np (cdr expr))         (let ((np (cdr math-simplify-expr))
1032               (try-cancel-units 0)               (try-cancel-units 0)
1033               n nn)               n nn)
1034           (setq n (if (eq (car-safe (nth 2 expr)) '*)           (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*)
1035                       (cdr (nth 2 expr))                       (cdr (nth 2 math-simplify-expr))
1036                     (nthcdr 2 expr)))                     (nthcdr 2 math-simplify-expr)))
1037           (if (math-realp (car n))           (if (math-realp (car n))
1038               (progn               (progn
1039                 (setcar (cdr expr) (math-mul (nth 1 expr)                 (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr)
1040                                              (let ((calc-prefer-frac nil))                                              (let ((calc-prefer-frac nil))
1041                                                (math-div 1 (car n)))))                                                (math-div 1 (car n)))))
1042                 (setcar n 1)))                 (setcar n 1)))
1043           (while (eq (car-safe (setq n (car np))) '*)           (while (eq (car-safe (setq n (car np))) '*)
1044             (math-simplify-units-divisor (cdr n) (cdr (cdr expr)))             (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr)))
1045             (setq np (cdr (cdr n))))             (setq np (cdr (cdr n))))
1046           (math-simplify-units-divisor np (cdr (cdr expr)))           (math-simplify-units-divisor np (cdr (cdr math-simplify-expr)))
1047           (if (eq try-cancel-units 0)           (if (eq try-cancel-units 0)
1048               (let* ((math-simplifying-units nil)               (let* ((math-simplifying-units nil)
1049                      (base (math-simplify (math-to-standard-units expr nil))))                      (base (math-simplify
1050                               (math-to-standard-units math-simplify-expr nil))))
1051                 (if (Math-numberp base)                 (if (Math-numberp base)
1052                     (setq expr base))))                     (setq math-simplify-expr base))))
1053           (if (eq (car-safe expr) '/)           (if (eq (car-safe math-simplify-expr) '/)
1054               (math-simplify-units-prod))               (math-simplify-units-prod))
1055           expr)))           math-simplify-expr)))
1056    
1057  (defun math-simplify-units-divisor (np dp)  (defun math-simplify-units-divisor (np dp)
1058    (let ((n (car np))    (let ((n (car np))
# Line 1094  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1099  Entries are (SYMBOL EXPR DOC-STRING TEMP
1099    
1100  (math-defsimplify ^  (math-defsimplify ^
1101    (and math-simplifying-units    (and math-simplifying-units
1102         (math-realp (nth 2 expr))         (math-realp (nth 2 math-simplify-expr))
1103         (if (memq (car-safe (nth 1 expr)) '(* /))         (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1104             (list (car (nth 1 expr))             (list (car (nth 1 math-simplify-expr))
1105                   (list '^ (nth 1 (nth 1 expr)) (nth 2 expr))                   (list '^ (nth 1 (nth 1 math-simplify-expr))
1106                   (list '^ (nth 2 (nth 1 expr)) (nth 2 expr)))                         (nth 2 math-simplify-expr))
1107           (math-simplify-units-pow (nth 1 expr) (nth 2 expr)))))                   (list '^ (nth 2 (nth 1 math-simplify-expr))
1108                           (nth 2 math-simplify-expr)))
1109             (math-simplify-units-pow (nth 1 math-simplify-expr)
1110                                      (nth 2 math-simplify-expr)))))
1111    
1112  (math-defsimplify calcFunc-sqrt  (math-defsimplify calcFunc-sqrt
1113    (and math-simplifying-units    (and math-simplifying-units
1114         (if (memq (car-safe (nth 1 expr)) '(* /))         (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1115             (list (car (nth 1 expr))             (list (car (nth 1 math-simplify-expr))
1116                   (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))                   (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr)))
1117                   (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))                   (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))
1118           (math-simplify-units-pow (nth 1 expr) '(frac 1 2)))))           (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2)))))
1119    
1120  (math-defsimplify (calcFunc-floor  (math-defsimplify (calcFunc-floor
1121                     calcFunc-ceil                     calcFunc-ceil
# Line 1120  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1128  Entries are (SYMBOL EXPR DOC-STRING TEMP
1128                     calcFunc-abs                     calcFunc-abs
1129                     calcFunc-clean)                     calcFunc-clean)
1130    (and math-simplifying-units    (and math-simplifying-units
1131         (= (length expr) 2)         (= (length math-simplify-expr) 2)
1132         (if (math-only-units-in-expr-p (nth 1 expr))         (if (math-only-units-in-expr-p (nth 1 math-simplify-expr))
1133             (nth 1 expr)             (nth 1 math-simplify-expr)
1134           (if (and (memq (car-safe (nth 1 expr)) '(* /))           (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /))
1135                    (or (math-only-units-in-expr-p                    (or (math-only-units-in-expr-p
1136                         (nth 1 (nth 1 expr)))                         (nth 1 (nth 1 math-simplify-expr)))
1137                        (math-only-units-in-expr-p                        (math-only-units-in-expr-p
1138                         (nth 2 (nth 1 expr)))))                         (nth 2 (nth 1 math-simplify-expr)))))
1139               (list (car (nth 1 expr))               (list (car (nth 1 math-simplify-expr))
1140                     (cons (car expr)                     (cons (car math-simplify-expr)
1141                           (cons (nth 1 (nth 1 expr))                           (cons (nth 1 (nth 1 math-simplify-expr))
1142                                 (cdr (cdr expr))))                                 (cdr (cdr math-simplify-expr))))
1143                     (cons (car expr)                     (cons (car math-simplify-expr)
1144                           (cons (nth 2 (nth 1 expr))                           (cons (nth 2 (nth 1 math-simplify-expr))
1145                                 (cdr (cdr expr)))))))))                                 (cdr (cdr math-simplify-expr)))))))))
1146    
1147  (defun math-simplify-units-pow (a pow)  (defun math-simplify-units-pow (a pow)
1148    (if (and (eq (car-safe a) '^)    (if (and (eq (car-safe a) '^)
# Line 1157  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1165  Entries are (SYMBOL EXPR DOC-STRING TEMP
1165    
1166  (math-defsimplify calcFunc-sin  (math-defsimplify calcFunc-sin
1167    (and math-simplifying-units    (and math-simplifying-units
1168         (math-units-in-expr-p (nth 1 expr) nil)         (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
1169         (let ((rad (math-simplify-units         (let ((rad (math-simplify-units
1170                     (math-evaluate-expr                     (math-evaluate-expr
1171                      (math-to-standard-units (nth 1 expr) nil))))                      (math-to-standard-units (nth 1 math-simplify-expr) nil))))
1172               (calc-angle-mode 'rad))               (calc-angle-mode 'rad))
1173           (and (eq (car-safe rad) '*)           (and (eq (car-safe rad) '*)
1174                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))
# Line 1170  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1178  Entries are (SYMBOL EXPR DOC-STRING TEMP
1178    
1179  (math-defsimplify calcFunc-cos  (math-defsimplify calcFunc-cos
1180    (and math-simplifying-units    (and math-simplifying-units
1181         (math-units-in-expr-p (nth 1 expr) nil)         (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
1182         (let ((rad (math-simplify-units         (let ((rad (math-simplify-units
1183                     (math-evaluate-expr                     (math-evaluate-expr
1184                      (math-to-standard-units (nth 1 expr) nil))))                      (math-to-standard-units (nth 1 math-simplify-expr) nil))))
1185               (calc-angle-mode 'rad))               (calc-angle-mode 'rad))
1186           (and (eq (car-safe rad) '*)           (and (eq (car-safe rad) '*)
1187                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))
# Line 1183  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1191  Entries are (SYMBOL EXPR DOC-STRING TEMP
1191    
1192  (math-defsimplify calcFunc-tan  (math-defsimplify calcFunc-tan
1193    (and math-simplifying-units    (and math-simplifying-units
1194         (math-units-in-expr-p (nth 1 expr) nil)         (math-units-in-expr-p (nth 1 math-simplify-expr) nil)
1195         (let ((rad (math-simplify-units         (let ((rad (math-simplify-units
1196                     (math-evaluate-expr                     (math-evaluate-expr
1197                      (math-to-standard-units (nth 1 expr) nil))))                      (math-to-standard-units (nth 1 math-simplify-expr) nil))))
1198               (calc-angle-mode 'rad))               (calc-angle-mode 'rad))
1199           (and (eq (car-safe rad) '*)           (and (eq (car-safe rad) '*)
1200                (math-realp (nth 1 rad))                (math-realp (nth 1 rad))

Legend:
Removed from v.1.4.2.3  
changed lines
  Added in v.1.4.2.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26