view lisp/calc/calc-frac.el @ 51743:f63c242330b2

2003-06-30 Roland Winkler <[e-mail]> * textmodes/bibtex.el (bibtex-sort-entry-class): new entry catch-all. (bibtex-sort-ignore-string-entries): default value t. (bibtex-entry-kill-ring-max): Reintroduced as it was removed erroneously in previous version. (bibtex-string-files): Docstring reflects new parsing scheme. (bibtex-autokey-transcriptions): Merge some rewrite entries, fix docstring, add # as one of the chars to crush (bibtex-autokey-prefix-string, bibtex-autokey-names) (bibtex-autokey-names-stretch, bibtex-autokey-additional-names) (bibtex-autokey-name-change-strings) (bibtex-autokey-name-case-convert, bibtex-autokey-name-length) (bibtex-autokey-name-separator, bibtex-autokey-year-length) (bibtex-autokey-use-crossref, bibtex-autokey-titlewords) (bibtex-autokey-title-terminators) (bibtex-autokey-titlewords-stretch) (bibtex-autokey-titleword-ignore) (bibtex-autokey-titleword-case-convert) (bibtex-autokey-titleword-abbrevs) (bibtex-autokey-titleword-abbrevs) (bibtex-autokey-titleword-change-strings) (bibtex-autokey-titleword-length) (bibtex-autokey-titleword-separator) (bibtex-autokey-name-year-separator) (bibtex-autokey-year-title-separator) (bibtex-autokey-before-presentation-function) (bibtex-entry-type-history, bibtex-entry-maybe-empty-head): Fix docstring. (bibtex-strings, bibtex-reference-keys): Use lazy-completion-table and make-variable-buffer-local. (bibtex-sort-entry-class-alist): Use downcase, account for catch-all. (bibtex-braced-string-syntax-table) (bibtex-quoted-string-syntax-table): New variables. (bibtex-parse-nested-braces): Remove. (bibtex-parse-field-string): Use syntax table and forward-sexp. (bibtex-parse-association): Simplify. (bibtex-parse-field-name): Obey bibtex-autoadd-commas. (bibtex-parse-field-text): Simplify. (bibtex-search-forward-field, bibtex-search-backward-field): argument BOUND can take value t. (bibtex-start-of-field, bibtex-start-of-name-in-field) (bibtex-end-of-name-in-field, bibtex-end-of-field) (bibtex-start-of-text-in-field, bibtex-end-of-text-in-field) (bibtex-start-of-text-in-string, bibtex-end-of-text-in-string) (bibtex-end-of-string, bibtex-type-in-head): Use defsubst. (bibtex-skip-to-valid-entry): Return buffer position of beginning and ending of entry. Update for changes of bibtex-search-entry. Simplify. (bibtex-map-entries): FUN is called with three arguments. (bibtex-search-entry): Return a cons pair with buffer positions of beginning and end of entry. (bibtex-enclosing-field): Simplify. (bibtex-format-entry): Use booktitle to set a missing title. (bibtex-autokey-get-names): Fiddle with regexps. (bibtex-generate-autokey): Use identity. (bibtex-parse-keys): Use simplified parsing algorithm if bibtex-parse-keys-fast is non-nil. Simplify. Change order of arguments. Return alist of keys. (bibtex-parse-strings): Simplify. Return alist of strings. (bibtex-complete-string-cleanup): Fix docstring. (bibtex-read-key): New function. (bibtex-mode): Fix docstring. Do not parse for keys and strings when the mode is entered. Set fill-paragraph-function to bibtex-fill-field. Setup font-lock-mark-block-function the way font-lock intended. (bibtex-entry): Use bibtex-read-key. Obey bibtex-autofill-types. (bibtex-parse-entry, bibtex-autofill-entry): New functions. (bibtex-print-help-message, bibtex-remove-OPT-or-ALT) (bibtex-Preamble): Avoid hard coded constants. (bibtex-make-field): Fix docstring. Simplify. (bibtex-beginning-of-entry): Always return new position of point. (bibtex-end-of-entry): Rearrange cond clauses. (bibtex-count-entries, bibtex-validate, bibtex-reformat): Update for changes of bibtex-map-entries. (bibtex-ispell-abstract): Do not move point. (bibtex-entry-index): Use downcase. Simplify. (bibtex-lessp): Handle catch-all. (bibtex-find-crossref): Turned into a command. (bibtex-find-entry): Simplify. Use bibtex-read-key. Fix regexp. (bibtex-clean-entry): Use bibtex-read-key. Handle string and preamble entries. (bibtex-fill-field-bounds): New function. (bibtex-fill-field): New command. Bound to fill-paragraph-function. (bibtex-fill-entry): Use bibtex-fill-field-bounds (bibtex-String): Use bibtex-strings. Always obey bibtex-sort-ignore-string-entries.

;;; calc-frac.el --- fraction functions for Calc

;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.

;; Author: David Gillespie <[e-mail]>
;; Maintainers: D. Goel <[e-mail]>
;;              Colin Walters <[e-mail]>

;; This file is part of GNU Emacs.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.

;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.

;;; Commentary:

;;; Code:

;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)

(require 'calc-macs)

(defun calc-Need-calc-frac () nil)

(defun calc-fdiv (arg)
  (interactive "P")
  (calc-slow-wrapper
   (calc-binary-op ":" 'calcFunc-fdiv arg 1)))


(defun calc-fraction (arg)
  (interactive "P")
  (calc-slow-wrapper
   (let ((func (if (calc-is-hyperbolic) 'calcFunc-frac 'calcFunc-pfrac)))
     (if (eq arg 0)
	 (calc-enter-result 2 "frac" (list func
					   (calc-top-n 2)
					   (calc-top-n 1)))
       (calc-enter-result 1 "frac" (list func
					 (calc-top-n 1)
					 (prefix-numeric-value (or arg 0))))))))


(defun calc-over-notation (fmt)
  (interactive
   (list
    (completing-read "Fraction separator: " (mapcar (lambda (s)
						      (cons s 0))
						    '(":" "::" "/" "//" ":/"))
		     nil t)))
  (calc-wrapper
   (if (string-match "\\`\\([^ 0-9][^ 0-9]?\\)[0-9]*\\'" fmt)
       (let ((n nil))
	 (if (/= (match-end 0) (match-end 1))
	     (setq n (string-to-int (substring fmt (match-end 1)))
		   fmt (math-match-substring fmt 1)))
	 (if (eq n 0) (error "Bad denominator"))
	 (calc-change-mode 'calc-frac-format (list fmt n) t))
     (error "Bad fraction separator format"))))

(defun calc-slash-notation (n)
  (interactive "P")
  (calc-wrapper
   (calc-change-mode 'calc-frac-format (if n '("//" nil) '("/" nil)) t)))


(defun calc-frac-mode (n)
  (interactive "P")
  (calc-wrapper
   (calc-change-mode 'calc-prefer-frac n nil t)
   (message (if calc-prefer-frac
		"Integer division will now generate fractions"
	      "Integer division will now generate floating-point results"))))


;;;; Fractions.

;;; Build a normalized fraction.  [R I I]
;;; (This could probably be implemented more efficiently than using
;;;  the plain gcd algorithm.)
(defun math-make-frac (num den)
  (if (Math-integer-negp den)
      (setq num (math-neg num)
	    den (math-neg den)))
  (let ((gcd (math-gcd num den)))
    (if (eq gcd 1)
	(if (eq den 1)
	    num
	  (list 'frac num den))
      (if (equal gcd den)
	  (math-quotient num gcd)
	(list 'frac (math-quotient num gcd) (math-quotient den gcd))))))

(defun calc-add-fractions (a b)
  (if (eq (car-safe a) 'frac)
      (if (eq (car-safe b) 'frac)
	  (math-make-frac (math-add (math-mul (nth 1 a) (nth 2 b))
				    (math-mul (nth 2 a) (nth 1 b)))
			  (math-mul (nth 2 a) (nth 2 b)))
	(math-make-frac (math-add (nth 1 a)
				  (math-mul (nth 2 a) b))
			(nth 2 a)))
    (math-make-frac (math-add (math-mul a (nth 2 b))
			      (nth 1 b))
		    (nth 2 b))))

(defun calc-mul-fractions (a b)
  (if (eq (car-safe a) 'frac)
      (if (eq (car-safe b) 'frac)
	  (math-make-frac (math-mul (nth 1 a) (nth 1 b))
			  (math-mul (nth 2 a) (nth 2 b)))
	(math-make-frac (math-mul (nth 1 a) b)
			(nth 2 a)))
    (math-make-frac (math-mul a (nth 1 b))
		    (nth 2 b))))

(defun calc-div-fractions (a b)
  (if (eq (car-safe a) 'frac)
      (if (eq (car-safe b) 'frac)
	  (math-make-frac (math-mul (nth 1 a) (nth 2 b))
			  (math-mul (nth 2 a) (nth 1 b)))
	(math-make-frac (nth 1 a)
			(math-mul (nth 2 a) b)))
    (math-make-frac (math-mul a (nth 2 b))
		    (nth 1 b))))


;;; Convert a real value to fractional form.  [T R I; T R F] [Public]
(defun calcFunc-frac (a &optional tol)
  (or tol (setq tol 0))
  (cond ((Math-ratp a)
	 a)
	((memq (car a) '(cplx polar vec hms date sdev intv mod))
	 (cons (car a) (mapcar (function
				(lambda (x)
				  (calcFunc-frac x tol)))
			       (cdr a))))
	((Math-messy-integerp a)
	 (math-trunc a))
	((Math-negp a)
	 (math-neg (calcFunc-frac (math-neg a) tol)))
	((not (eq (car a) 'float))
	 (if (math-infinitep a)
	     a
	   (if (math-provably-integerp a)
	       a
	     (math-reject-arg a 'numberp))))
	((integerp tol)
	 (if (<= tol 0)
	     (setq tol (+ tol calc-internal-prec)))
	 (calcFunc-frac a (list 'float 5
				(- (+ (math-numdigs (nth 1 a))
				      (nth 2 a))
				   (1+ tol)))))
	((not (eq (car tol) 'float))
	 (if (Math-realp tol)
	     (calcFunc-frac a (math-float tol))
	   (math-reject-arg tol 'realp)))
	((Math-negp tol)
	 (calcFunc-frac a (math-neg tol)))
	((Math-zerop tol)
	 (calcFunc-frac a 0))
	((not (math-lessp-float tol '(float 1 0)))
	 (math-trunc a))
	((Math-zerop a)
	 0)
	(t
	 (let ((cfrac (math-continued-fraction a tol))
	       (calc-prefer-frac t))
	   (math-eval-continued-fraction cfrac)))))

(defun math-continued-fraction (a tol)
  (let ((calc-internal-prec (+ calc-internal-prec 2)))
    (let ((cfrac nil)
	  (aa a)
	  (calc-prefer-frac nil)
	  int)
      (while (or (null cfrac)
		 (and (not (Math-zerop aa))
		      (not (math-lessp-float
			    (math-abs
			     (math-sub a
				       (let ((f (math-eval-continued-fraction
						 cfrac)))
					 (math-working "Fractionalize" f)
					 f)))
			    tol))))
	(setq int (math-trunc aa)
	      aa (math-sub aa int)
	      cfrac (cons int cfrac))
	(or (Math-zerop aa)
	    (setq aa (math-div 1 aa))))
      cfrac)))

(defun math-eval-continued-fraction (cf)
  (let ((n (car cf))
	(d 1)
	temp)
    (while (setq cf (cdr cf))
      (setq temp (math-add (math-mul (car cf) n) d)
	    d n
	    n temp))
    (math-div n d)))



(defun calcFunc-fdiv (a b)   ; [R I I] [Public]
  (if (Math-num-integerp a)
      (if (Math-num-integerp b)
	  (if (Math-zerop b)
	      (math-reject-arg a "*Division by zero")
	    (math-make-frac (math-trunc a) (math-trunc b)))
	(math-reject-arg b 'integerp))
    (math-reject-arg a 'integerp)))

;;; calc-frac.el ends here