Function: math-simplify-sqrt

math-simplify-sqrt is an autoloaded and byte-compiled function defined in calc-alg.el.gz.

Signature

(math-simplify-sqrt EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-alg.el.gz
(defun math-simplify-sqrt (expr)
  (or (and (eq (car-safe (nth 1 expr)) 'frac)
	   (math-div (list 'calcFunc-sqrt
                           (math-mul (nth 1 (nth 1 expr))
                                     (nth 2 (nth 1 expr))))
		     (nth 2 (nth 1 expr))))
      (let ((fac (if (math-objectp (nth 1 expr))
		     (math-squared-factor (nth 1 expr))
		   (math-common-constant-factor (nth 1 expr)))))
	(and fac (not (eq fac 1))
	     (math-mul (math-normalize (list 'calcFunc-sqrt fac))
		       (math-normalize
			(list 'calcFunc-sqrt
			      (math-cancel-common-factor
                               (nth 1 expr) fac))))))
      (and math-living-dangerously
	   (or (and (eq (car-safe (nth 1 expr)) '-)
		    (math-equal-int (nth 1 (nth 1 expr)) 1)
		    (eq (car-safe (nth 2 (nth 1 expr))) '^)
		    (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2)
		    (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
				 'calcFunc-sin)
			     (list 'calcFunc-cos
				   (nth 1 (nth 1 (nth 2 (nth 1 expr))))))
			(and (eq (car-safe (nth 1 (nth 2 (nth 1 expr))))
				 'calcFunc-cos)
			     (list 'calcFunc-sin
				   (nth 1 (nth 1 (nth 2
                                                      (nth 1 expr))))))))
	       (and (eq (car-safe (nth 1 expr)) '-)
		    (math-equal-int (nth 2 (nth 1 expr)) 1)
		    (eq (car-safe (nth 1 (nth 1 expr))) '^)
		    (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2)
		    (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr))))
			     'calcFunc-cosh)
			 (list 'calcFunc-sinh
			       (nth 1 (nth 1 (nth 1 (nth 1 expr)))))))
	       (and (eq (car-safe (nth 1 expr)) '+)
		    (let ((a (nth 1 (nth 1 expr)))
			  (b (nth 2 (nth 1 expr))))
		      (and (or (and (math-equal-int a 1)
				    (setq a b b (nth 1 (nth 1 expr))))
			       (math-equal-int b 1))
			   (eq (car-safe a) '^)
			   (math-equal-int (nth 2 a) 2)
			   (or (and (eq (car-safe (nth 1 a)) 'calcFunc-sinh)
				    (list 'calcFunc-cosh (nth 1 (nth 1 a))))
                               (and (eq (car-safe (nth 1 a)) 'calcFunc-csch)
				    (list 'calcFunc-coth (nth 1 (nth 1 a))))
			       (and (eq (car-safe (nth 1 a)) 'calcFunc-tan)
				    (list '/ 1 (list 'calcFunc-cos
						     (nth 1 (nth 1 a)))))
			       (and (eq (car-safe (nth 1 a)) 'calcFunc-cot)
				    (list '/ 1 (list 'calcFunc-sin
						     (nth 1 (nth 1 a)))))))))
	       (and (eq (car-safe (nth 1 expr)) '^)
		    (list '^
			  (nth 1 (nth 1 expr))
			  (math-div (nth 2 (nth 1 expr)) 2)))
	       (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt)
		    (list '^ (nth 1 (nth 1 expr)) (math-div 1 4)))
	       (and (memq (car-safe (nth 1 expr)) '(* /))
		    (list (car (nth 1 expr))
			  (list 'calcFunc-sqrt (nth 1 (nth 1 expr)))
			  (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))))
	       (and (memq (car-safe (nth 1 expr)) '(+ -))
		    (not (math-any-floats (nth 1 expr)))
		    (let ((f (calcFunc-factors (calcFunc-expand
						(nth 1 expr)))))
		      (and (math-vectorp f)
			   (or (> (length f) 2)
			       (> (nth 2 (nth 1 f)) 1))
			   (let ((out 1) (rest 1) (sums 1) fac pow)
			     (while (setq f (cdr f))
			       (setq fac (nth 1 (car f))
				     pow (nth 2 (car f)))
			       (if (> pow 1)
				   (setq out (math-mul out (math-pow
							    fac (/ pow 2)))
					 pow (% pow 2)))
			       (if (> pow 0)
				   (if (memq (car-safe fac) '(+ -))
				       (setq sums (math-mul-thru sums fac))
				     (setq rest (math-mul rest fac)))))
			     (and (not (and (eq out 1) (memq rest '(1 -1))))
				  (math-mul
				   out
				   (list 'calcFunc-sqrt
					 (math-mul sums rest))))))))))))