In all cultures over all time there appears, in different languages for different countries, the maxim "Shirtsleeves to shirtsleeves in three generations." This is a function with three phases exhibiting first growth then maintenance, then dissipation. The patriarch gets off the boat penniless, builds a comfortable life, leaves it to his son who manages to hold onto it until he then leaves it to his son who spends it. The society-wide equivalent for nation states is known as "Tytler's Cycle."
Assume a Phase I accumulation rate of Exp[a r t] where "r" is a rate we will fix at 9% for now, "t" is time and "a" is a damper or weariness factor which declines over time. Phase I plots like this
Plot[Evaluate@Table[E^(a .09 t), {a, {.99, .7, .55}}], {t, 1, 50},
Frame -> {True, True, False, False},
FrameLabel -> {"Time (t)", "Accumulation"},
PlotStyle -> {Blue, Green, Red},
PlotLabel -> "production = \!\(\*SuperscriptBox[\(\[ExponentialE]\), \(a\\\ \.09, t\)]\)",
PlotLegends -> {"a = .99", "a = .70", "a = .55"}]
displaying three sub phases of decline in "a" as Dad ages and tires. We will return to connecting phases I and III, later.
The dissipation phase is also exponential with the accumulated capital, "C", being eroded as C Exp[-(1/a) .09 t] where "C" is a constant representing the capital accumulated in Phase I and "a" is now the rate of profligacy and indolence. Three possible profiles plot thus:
Plot[Evaluate@Table[100 E^(- (1/a) .09 t), {a, {.50, .35, .15}}], {t, 6, 20},
Frame -> {True, True, False, False},
FrameLabel -> {"Time (t)", "Accumulation"},
PlotStyle -> {Blue, Green, Red},
PlotLabel -> "production = 700 \!\(\*SuperscriptBox[\(\[ExponentialE]\), \\(\(-\*FractionBox[\(1\), \(a\)]\)\\\ .09, t\)]\)",
PlotLegends -> {"a = .50", "a = .35", "a = .15"}]
Rather than have this process look like the side view of a volcanic mountain, Phase II needs rounded corners to make the function everywhere differentiable. We assume little or no growth in Phase II so the length of time is not so important.
Here is a preview using a numerical method
seg1 = MapThread[(E^(#1 .09 #2)) &, {Table[i, {i, .99, .51, -.02}], Range[25]}];
seg2 = ConstantArray[E^(.51 .09 25), 10];
ListLinePlot[Join[seg1, seg2, Reverse[seg1]]]
Interpolation will make it into a function. But to have an interactive Manipulate where all the variables can be changed, it seems to me that the the most general approach might be a differential equation using WhenEvent for the tipping point when the functional form of "a" changes sometime near the end of Phases II. I have struggled to make that work and so far have only been able to construct the separate pieces.
Help collecting the parts into a cohesive whole will be appreciated.
