functional programming - wolfram-mathematica

Question

Suppose I have this Mathematica code, whose output, a real number, depends on the input, say, x,y,z. How do I make a real-valued function in x,y,z based on the code?
If the code describes a simple relationship among x,y,z, I could define this function directly. The point here is that the given code is a very complicated block (or module).
For example, if the code simply sums x,y,z, I would simply define
f[x_,y_,z_]=x+y+z
What if I have a very complex example, like the one below:
s0[a_, b_, x_] :=
{1, 0, (a + b) x + (1 - a - b)}
s1[a_, b_, c_, d_, p_, q_, n_, x_] :=
Which[0 <= x <= c, {2, n - 1, x/c*q + p},
c <= x <= c + d, {2, n, (x - c)/d*p},
c + d <= x <= 1, {1, n + 1, (x - (c + d))/(1 - c - d)*(1 - a - b)}]
s2[s_, t_, c_, d_, p_, q_, n_, x_] :=
Which[0 <= x <= 1 - s - t, {2, n - 1,
x/(1 - s - t)*(1 - p - q) + p + q},
1 - s - t <= x <= 1 - s, {3,
n - 1, (x - (1 - s - t))/t*(1 - c - d) + c + d},
1 - s <= x <= 1, {3, n, (x - (1 - s))/s*d + c}]
s3[c_, a_, b_, s_, t_, n_, x_] :=
Which[0 <= x <= 1 - a - b, {4, n - 1, x/(1 - a - b)*t + 1 - s - t},
1 - a - b <= x <= 1 - a, {4, n, (x - (1 - a - b))/b*(1 - s - t)},
1 - a <= x <= 1, {3, n + 1, (x - (1 - a))/a*c}]
s4[p_, q_, s_, a_, b_, n_, x_] :=
Which[0 <= x <= p, {4, n - 1, x/p*s + 1 - s},
p <= x <= p + q, {5, n - 1, (x - p)/q*a/(a + b) + b/(a + b)},
p + q <= x <= 1, {5, n, (x - (p + q))/(1 - p - q)*b/(a + b)}]
F[{k_, n_, x_}] :=
Which[k == 0, s0[a, b, x],
k == 1, s1[a, b, c, d, p, q, n, x],
k == 2, s2[s, t, c, d, p, q, n, x],
k == 3, s3[c, a, b, s, t, n, x],
k == 4, s4[p, q, s, a, b, n, x]]
G[x_] := NestWhile[F, {0, 0, x}, Function[e, Extract[e, {1}] != 5]]
H[x_] := Extract[G[x], {2}] + Extract[G[x], {3}]
H[0]
For the above code to run, one needs to specify the list
{a,b,c,d,p,q,s,t}
And the output are real numbers. How does one define a function in a,b,c,d,p,q,s,t that spits out these real numbers?

Answer 1

Your essential problem is that you have a large number of parameters in your auxiliary functions, but your big-letter functions (F, G and H and by the way single-capital-letter function names in Mathematica are a bad idea) only take three parameters and your auxiliary functions (s0 etc) only return three values in the returned list.
You have two possible ways to fix this.
You can either redefine everything to require all the parameters required in the whole system - I'm assuming that common parameter names across the auxiliary functions really are common values - like this:
G[x_, a_, b_, c_, d_, p_, q_, s_, t_] :=
NestWhile[F, {0, 0, x, a, b, c, d, p, q, s, t},
Function[e, Extract[e, {1}] != 5]]
or
You can set some options that set these parameters globally for the whole system. Look up Options and OptionsPattern. You would do something like this:
First, define default options:
Options[mySystem] = {aa -> 0.2, bb -> 1., cc -> 2., dd -> 4.,
pp -> 0.2, qq -> 0.1, ss -> 10., tt -> 20.}
SetOptions[mySystem, {aa->0.2, bb->1., cc->2., dd->4., pp->0.2,
qq->0.1, ss->10., tt->20.}]
Then write your functions like this:
F[{k_, n_, x_}, OptionsPattern[mySystem]] :=
With[{a = OptionValue[aa], b = OptionValue[bb], c = OptionValue[cc],
d = OptionValue[dd], p = OptionValue[pp], q = OptionValue[qq],
s = OptionValue[ss], t = OptionValue[tt]},
Which[k == 0, s0[a, b, x], k == 1, s1[a, b, c, d, p, q, n, x],
k == 2, s2[s, t, c, d, p, q, n, x], k == 3,
s3[c, a, b, s, t, n, x], k == 4, s4[p, q, s, a, b, n, x]] ]
There is also something quite wrong with your use of Extract (you are assuming there are more parts in your list than are actually there in the first few iterations), but this answers your main issue.