# Recursive calculation is very slow

I've got a recursive definition of Arcs that shares equal length and a several other dependencies to each respective predecessor. (Imagine a book being bent.)

I formulated all necessary things here:

Pa[n_] := {d1 (0.5 + n), 0}
Pb[n_] := Pa[n] + R[n]*{1 - Cos[alpha[n]], Sin[alpha[n]]}
Pc[n_] := Pb[n - 1] + d2*{Cos[alpha[n - 1]], -Sin[alpha[n - 1]]}
R[n_] := Piecewise[{{(-Pa[n][]^2 + 2*Pa[n][]*Pc[n][] -
Pc[n][]^2 - Pc[n][]^2)/
(2*(Pa[n][] - Pc[n][])), n > 0}, {R0, n == 0}}]
M[n_] := {R[n] + Pa[n][], 0}
alpha[n_] := len/R[n]


When I plot it up to order of 3, it takes a while, but it works.

Manipulate[
Evaluate[
Show[
Graphics[
Table[Circle[M[i], R[i], {Pi - alpha[i], Pi}], {i, 0, 3}]
],
PlotRange -> {{0, 100}, {0, len*1.2}},
Frame -> True
]
],
{{R0, 10000}, 0, 10000},
{{len, 70}, 0, 500},
{{d1, 4.3}, 0, 20},
{{d2, 13}, 0, 20}
]


What can I do to make it calculate really fast for order 3 and higher?

• At least look here. Sep 17 '15 at 20:48
• It might help to look up "Functions That Remember Values They Have Found" in the documentation. Sep 17 '15 at 20:48
• @march Thanks for the hint. Unfortunately, this does not seem to help, at least not inside the Manipulate[]-environment. In addition, I'd really like to understand, why it is necessary to Evaluate[] the Show[], to have it work.
– DPF
Sep 18 '15 at 7:36

I think I made it work.

Remembering function values is one key, but I needed another one: a Module

arc[mn_, mR0_, mlen_, md1_, md2_] :=
Module[{n = mn, Pa, Pb, Pc, R, M, alpha, R0 = mR0, len = mlen,
d1 = md1, d2 = md2},
Pa[n_] := Pa[n] = {d1*(0.5 + n), 0};
Pb[n_] := Pb[n] = Pa[n] + R[n]*{1 - Cos[alpha[n]], Sin[alpha[n]]};
Pc[n_] := Pc[n] = Pb[n - 1] + d2*{Cos[alpha[n - 1]], -Sin[alpha[n - 1]]};
R[n_]  := R[n] =
Piecewise[{{(-Pa[n][]^2 + 2*Pa[n][]*Pc[n][] -
Pc[n][]^2 - Pc[n][]^2)/(2*(Pa[n][] - Pc[n][])),
n > 0}, {R0, n == 0}}];
M[n_]  := M[n] = {R[n] + Pa[n][], 0};
alpha[n_] := alpha[n] = len/R[n];

Circle[M[n], R[n], {Pi - alpha[n], Pi}]
]


and then:

 Manipulate[
Evaluate[
Show[
Graphics[
Table[arc[i, R0, len, d1, d2], {i, 0, n}]
],
PlotRange -> {{0, n*d1 + len}, {-20, len*1.2}},
Frame -> True
]
],
{{n, 3}, 0, 20, 1},
{{R0, 10000}, 0, 10000},
{{len, 70}, 0, 500},
{{d1, 4.3}, 0, 20},
{{d2, 13}, 0, 20}
]