2
$\begingroup$

I came across the following two internal functions SimplifyDump`AbsToSign and SimplifyDump`SignToAbs that have been written procedurally. Here are the source codes:

AbsToSign[expr] attempts to convert Abs[] in expr to Sign[].

AbsToSign[e_Times] := 
  Module[{ans = e, el, i, n, tmp}, 
    n = Length[ans]; 
    i = 1; 
    While[i <= n, 
      el = Replace[ans[[i]], Abs[x_]^k_. :> (x/Sign[x])^k /; IntegerQ[k]]; 
      If[el =!= ans[[i]], tmp = Drop[ans, {i}] el; 
        If[LeafCount[tmp] <= LeafCount[ans], 
          If[Head[tmp] =!= Times, Return[tmp, Module]]; 
          ans = tmp; 
          n = Length[ans]; i = 1, i++
        ], i++]
      ];
  ans];

SignToAbs[expr] attempts to convert products of Sign[] in expr to Abs[], and yields $Failed if unable.

SignToAbs[e_Times] := 
  Module[{ss, ee, num, tmp}, 
    ss = Select[List @@ e, Head[#1] === Sign && Length[#1] == 1 && Assumptions`ARealQ[#1[[1]]] &];
    If[ss === {}, Return[$Failed]];
    ee = e/Times @@ ss; num = Numerator[ee]; ee = ee/num; 
    Do[
      tmp = Cancel[num/ss[[i, 1]]]; 
      If[NumberQ[Denominator[tmp]], 
        num = tmp; 
        ee *= Abs[ss[[i, 1]]], 
        ee *= ss[[i]]
      ], {i, Length[ss]}
    ]; 
    ee *= num; 
    If[ee === e, $Failed, ee]
  ];

Example:

Assuming[x > 0, SimplifyDump`SignToAbs[2 * Sign[Cos[x]]]]
(* 2 Abs[Cos[x]] Sec[x] *)

Assuming[x > 0, SimplifyDump`AbsToSign[2 Abs[Cos[x]] Sec[x]]]
(* 2/Sign[Cos[x]] *)

How would you rerwite these internal routines in functional style, eliminating the occurrences of While and Do in the codes?

SignToAbs call the kernel function Assumptions`ARealQ[expr] which does the following:

Assumptions`ARealQ[expr] yields True if the global variable $Assumptions implies expr is real, and yields False otherwise.

$\endgroup$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.