2
$\begingroup$

I want to calculate something like o[n, o[n, o[n, n]]]

Where n means a number and o means a operation.

During the calculation process there are some very large numbers and they are meaningless for me.

Just stop calculating and return Indeterminate.

In fact Mathematica will Automatic abort and throw error Throw::sysexc, that means out of memory and the results all disappear.

In []:= pattern=o[2,o[2,o[8,13]]];
        tps=Tuples[{Plus,Subtract,Times,Divide,Power,Log,#1^(1/#2)&},3];
        ReplacePart[pattern,Thread[Position[pattern,o]->#]]&/@tps
Out[]:= SystemException["MemoryAllocationFailure"]`

Is there any way to solve this with some settings?

I don't want to reconstruct my functions.

upBound=10^10;lowBound=1/upBound;
With/Block[{...},
    .............
    myFun/@myList
]
$\endgroup$
  • 1
    $\begingroup$ You could try using MemoryConstrained $\endgroup$ – Carl Woll Dec 23 '17 at 3:20
  • $\begingroup$ It's hard to estimate how much memory a particular step needs. $\endgroup$ – GalAster Dec 23 '17 at 3:28
  • $\begingroup$ Perhaps, NestWhile would be helpful, if I understand your question correctly. $\endgroup$ – bbgodfrey Dec 23 '17 at 3:37
  • $\begingroup$ Well, that pattern just an example...also can be something like o[o[o[n, n], n], o[n, n]]... $\endgroup$ – GalAster Dec 23 '17 at 3:55
  • $\begingroup$ I think there is a problem with the strategy sought in the question: For instance 8^13 really isn't that big (it's a machine-size integer), but 2^(8^13) crashes my kernel -- I don't even get the Throw::sysexc error. So I never found out that the number was too large before the crash. $\endgroup$ – Michael E2 Dec 23 '17 at 17:37
5
$\begingroup$

Here's one way, using Carl Woll's suggestion of MemoryConstrained, which runs very quickly:

Do[
 ans[t] = 
  MemoryConstrained[
   ReplacePart[pattern, Thread[Position[pattern, o] -> t]], 
   8*^9,         (* depending on how much memory you have *)
   $Failed[t]],
 {t, tps}
 ]

General::ovfl: Overflow occurred in computation.

You can do this with Map instead of Do, but Map would store up the results in addition to storing the result in ans[#]. If some answers were big, it would waste memory.

Here's how to see which failed:

Cases[DownValues@ans, _[_, _$Failed]]
(*
{HoldPattern[ans[{Divide, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Log, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Plus, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Power, Plus, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Power, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Power, Subtract, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Power, Times, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Subtract, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{Times, Power, Power}]] :> $Failed[t], 
 HoldPattern[ans[{#1^(1/#2) &, Divide, Power}]] :> $Failed[t], 
 HoldPattern[ans[{#1^(1/#2) &, Power, Power}]] :> $Failed[t]}
*)

Perhaps you can figure out a way to deal with some of them, perhaps doing one operation at a time instead of substituting for all three o at once.

All 343 answers, including failures may be obtained with the following:

Values@ DownValues@ ans

This should give the same answer as the original code, if it worked. If you want them with the tuples, as in the failures above, omit the Values@. Failures may be deleted with DeleteCases, which works like Cases.

$\endgroup$
1
$\begingroup$

You may use Throw and Catch with a helper function in FoldPair to stop calculating when the intermediate result is outside of lowBound <= x <= upBound

First a helper function for FoldList that performs the replacement and returns both the resulting expression and the expression (value) at the position of the replacement.

ClearAll[replacePartValue];
replacePartValue[expr_, r : pos_ -> new_, b : {lower_, upper_}] :=
 {
    With[{v = #[[Sequence @@ Most@pos]]},
     If[lower <= v <= upper,
      v,
      Throw[Indeterminate]
      ]],
    #
    } &@ReplacePart[expr, pos -> new]

Giving

replacePartValue[pattern, {2, 2, 0} -> Plus]
{21, o[2, o[2, 21]]}

replacePartValue also takes the upper and lower bounds to check if the result at the position of the replacement is within bounds. If it is not then it Throws Indeterminate.

For the bounds check to work the replacements must occur at the deepest levels first and then work upward to the most shallow levels. At the same time the ordinal location of the placeholders (o) must match to the ordinal locations of the functions in the tps list. Therefore, the positions and functions must be paired first and then Reverse SortByed the First element in the pair (the position) before Applying Rule to the pairs for use in Replace. This logic is the third argument in FoldPair below.

Finally FoldPair is wrapped in Catch to capture any Throws from replacePartValue. This is mapped across tps.

With pattern and tps as defined in OP and

pos = Position[pattern, o]

Then

res =
  Catch[
     FoldPair[
      replacePartValue[#1, #2, {lowBound, upBound}] &,
      pattern,
      Rule @@@ Reverse@SortBy[First]@Thread@{pos, #}
      ]] & /@ tps ;

(*First 5*)
res[[;; 5]]
{25, Indeterminate, 108, 60/13, Indeterminate}

Hope this helps.

$\endgroup$
1
$\begingroup$

Here's another way that implements a numeric check on the size of the result, somewhat like what the OP asked for. The trick is to compute the result first in floating-point. If it's in some range, then proceed with the exact computation. This can be done with a simple helper wrapper:

ClearAll[numChk];
numChk[op_][x_?NumericQ, y_?NumericQ] /; 
   10^-1000 < Abs@op[N@x, N@y] < 10^1000 := op[x, y];  (* adjust range as desired *)

res = ReplacePart[pattern, Thread[Position[pattern, o] -> #]] & /@ 
   Map[numChk, tps, {2}];

On a valid result, NumericQ will return True. Here is a way to see all the computations that failed:

DeleteCases[res, _?NumericQ]
(*
{numChk[Plus][2, numChk[Power][2, 549755813888]], 
 numChk[Subtract][2, numChk[Power][2, 549755813888]], 
 numChk[Times][2, numChk[Power][2, 549755813888]], 
 numChk[Divide][2, numChk[Power][2, 549755813888]], 
 numChk[Power][2, 549755813890], numChk[Power][2, -549755813886], 
 numChk[Power][2, 1099511627776], numChk[Power][2, 2097152], 
 numChk[Power][2, 20282409603651670423947251286016], 
 numChk[Power][2, numChk[Power][2, 549755813888]], 
 numChk[Log][2, numChk[Power][2, 549755813888]], 
 numChk[#1^(1/#2) &][2, 1/274877906944], 
 numChk[#1^(1/#2) &][2, numChk[Power][2, 549755813888]]}
*)

Sometimes the computation fails at the last op, sometimes at the second-to-last op in the test example.

If you use DeleteCases[res, _?NumericQ] /. numChk -> Inactive, you get a nicer-looking list of failures:

Mathematica graphics

These are the same failures as in my other answer.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.