Is there any loop alternative to using If[], Which[] or Piecewise[] ?

Questions
1

Hello,

I need to implement a piecewise function composed of many separate functions defined over many subintervals. I am looking for a construct that would allow me to achieve this goal in a compact way by using some loop (say For[] or Do[] ) for checking which function to select for a given value of an argument. Is there any way to do this? Implementations involving Which[] or Piecewise[] all require
writing a long sequence of conditions and expressions for the particular functions, which is somewhat inconvenient. In addition, if new subintervals are added, one has to modify the code for the piecewise function. For example, in the case of three subintervals, one can write:

Fun[x_]:=Which[
x>a[1] && x<=b[1], f[1][x],
x>a[2] && x<=b[2], f[2][x],
x>a[3] && x<=b[3], f[3][x]
];

but this becomes awkward if there are several dozens of subintervals, so that some loop construct might be simpler, if this is possible. Please note that the interval bounds and functions f[] are all indexed.

Lesław

2

Piecewise is a good choice for this. Note that Piecewise evaluates the conditions in turn, until one of them evaluates to True. If the intervals are contiguous and listed in order, then only one boundary need be specified for each. A new interval could be added to the chain as long as it is added at the correct place in the order.

Like this:

f[1] = 1; f[2] = 2; f[3] = 3;

f[x_] := Piecewise[{
   {f[1], x < 1},
   {f[2], x < 2},
   {f[3], x < 3},
   {5, True}
   }]

Plot[f[x], {x, 0, 5}]

The f[n] can of course be functions of x rather than constants.

3

There isn’t enough code or description to be completely sure of the problem, but here’s a shot:

(ff[#] = {Sin, Cos, Exp}[[#]]) & /@ Range[3];
(aa[#] = N@#) & /@ Range[3];
(bb[#] = aa[#] + RandomReal[]) & /@ Range[3];
data = Table[Line[{{aa[x]}, {bb[x]}}] -> ff[x], {x, 3}];
myF[x_?NumericQ] := 
 Replace[Nearest[data, x, {1, 0}, 
   DistanceFunction -> (RegionDistance[#2, {#1}] &)], {{func_} :> 
    func[x], {} -> Undefined, _ -> "Can't happen (?)"}]

myF /@ Subdivide[1., 4., 25]
(*
{0.841471, 0.9001, Undefined, Undefined, Undefined, Undefined, 
Undefined, Undefined, Undefined, -0.487482, -0.588501, -0.681056, 
-0.763815, -0.835589, -0.895344, Undefined, Undefined, 20.9052, 
23.5706, 26.5758, 29.9641, 33.7844, 38.0918, Undefined, Undefined, 
Undefined}
*)

data
(*
{Line[{{1.}, {1.15606}}] -> Sin,
 Line[{{2.}, {2.77624}}] -> Cos, 
 Line[{{3.}, {3.6764}}] -> Exp}
*)

Or this:

(ff[#] = {100. &, -#^2 &, Exp}[[#]]) & /@ Range[3];
(aa[#] = N@#^2) & /@ Range[3];
(bb[#] = aa[#] + RandomReal[{1, 3}]) & /@ Range[3];
data = Table[aa[x], {x, 3}];
nf = Nearest[data -> "Index"];
myF2[x_?NumericQ] := Replace[nf[x, 1],
  {{k_} /; aa[k] < x <= bb[k] :> ff[k][x],
   {k_} /; aa[k - 1] < x <= bb[k - 1] :> ff[k - 1][x],
   {_} -> Undefined, _ -> "Can't happen (?)"}]

myF2 /@ Subdivide[1., 10., 20]
(*
{Undefined, 100., 100., 100., Undefined, Undefined, Undefined, 
-17.2225, -21.16, -25.5025, -30.25, Undefined, Undefined, Undefined, 
Undefined, Undefined, Undefined, Undefined, 8955.29, 14044.7, 22026.5}
*)
4

I did a bit of experimenting, and it seems that the following example code does what I need:

a[1]=0;
a[2]=1;
a[3]=3;
b[1]=1;
b[2]=3;
b[3]=6;
f[1][x_]:=10;
f[2][x_]:=20;
f[3][x_]:=30;
nintervals=3;
Fun[x_]:=Module[{n,v},
If[x<a[1] || x>b[nintervals],v=Indeterminate,For[n=1,n<=nintervals,n=n+1, If[x>=a[n]&&x<=b[n],v=f[n][x];Break[]]]];
v];

The trick is to use the Break[] command, to interrupt the loop. I did not realise it was possible, as the help files provide only the two variants of If[]:

If[condition,t,f]

and

If[condition,t,f,u]

but don’t provide

If[condition,t]

which is needed here.

5

I would do it like this:

fun[x_] =
 Piecewise[
  Table[{f[i][x], a[i] < x <= b[i]},
   {i, 3}], "Undefined"]
Plot[fun[x], {x, -1, 7}]
6

If the intervals are contiguous, listed in order and of equal width, then it is also possible to make a list of functions and then the input variable can be mapped to the correct function in the list. I just recently did this for about 30 intervals and worked well. I can post code if there is interest.

7

Thanks, but the intervals are not of equal length.

Lesław

8

I have tried the version with Piecewise + Table, but in such a case a get a strange error. In my program, functions f[n][] are calculated by Interpolating Function objects obj[1] and obj[2] obtained by NDSolve, while solving some ODEs. My code is:

obj[1]=Import["obj1.m"];
obj[2]=Import["obj2.m"];
nmax=2;
For[n=1,n<=nmax,n=n+1,heads[n]=Head[(Subscript[psix, 1][th]/.obj[n])]];
For[n=1,n<=nmax,n=n+1,a[n]=SetPrecision[First[First[heads[n]["Domain"]]],Infinity]];
For[n=1,n<=nmax,n=n+1,b[n]=SetPrecision[Last[First[heads[n]["Domain"]]],Infinity]];
bounds=N[Table[{a[n],b[n]},{n,1,nmax,1}],25]
{{881.3511598761730369258651,52027.18417423114383137352},{52027.18417423114383137352,1.093770863505275159944475*10^7}}
For[n=1,n<=nmax,n=n+1,f[n][th_]:=Evaluate[(Subscript[psix, 1][th]/.obj[n])]];
Fun1[th_]:=Piecewise[Table[{f[n][th],th>a[n]&&th<=b[n]},{n,1,nmax}],"Undefined"];
Fun2[th_]:=Module[{n,v},
If[th<a[1] || th>b[nmax],v=Indeterminate,For[n=1,n<=nmax,n=n+1, If[th>=a[n]&&th<=b[n],v=f[n][th];Break[]]]];
v];
Fun1[10001.176032248239`]
InterpolatingFunction::dmval: Input value {10001.2} lies outside the range of data in the interpolating function. Extrapolation will be used.
1.11039
f[1][10001.176032248239`]
1.11039
Fun2[10001.176032248239`]
1.11039

As can be seen, functions Fun1[th], f[1][th] and Fun2[th] all return the same (seemingly correct) value for a certain argument, but in the case of Fun1[th], which uses Piecewise[], there is an incomprehensible error message. It is incomprehensible, because the argument value lies within the domain covered by obj[1]. How to understand what happens here?
Unfortunately I cannot attach the obj1.m and obj2.m files, because they have ca. 40MB each.

Lesław

9

I don’t know why that error message comes out. An unrelated suggestion: if you use NDSolveValue instead of NDSolve, as in

sol = NDSolveValue[{x'[t] == x[t], x[0] == 1}, x, {t, 0, 1}]

you can extract the domain with just First@sol["Domain"] and calculate the value with sol[t].

10

You have some unnecessary and overly complicated definitions. I’d suggest something along the following lines (I don’t know your whole context, so there are probably further improvements, but hopefully this will get you started):

First, encode your rules as data:

intervalFunctionMap = 
  <|Interval[{0, 1}] -> f[1], 
    Interval[{1, 3}] -> f[2], 
    Interval[{3, 6}] -> f[3]|>

Now just define your function as a selection:

Fun[x_] := 
  First[KeySelect[intervalFunctionMap, IntervalMemberQ[#, x] &], Indeterminate &][x]

Demo:

Fun /@ Range[-1, 7, .5]
(* {Indeterminate, Indeterminate, f[1][0.], f[1][0.5], f[1][1.], 
    f[2][1.5], f[2][2.], f[2][2.5], f[2][3.], f[3][3.5], f[3][4.], 
    f[3][4.5], f[3][5.], f[3][5.5], 
    f[3][6.], Indeterminate, Indeterminate} *)