# How can I automatically perform Buffalo Way replacement?

Buffalo Way is a common method for proving inequalities by substituting variables $$a_1, \dots, a_n$$ in the following manner: \begin{align} a_1 &\to a_1 \\ a_2 &\to a_1 + x_2 \\ a_3 &\to a_1 + x_2 + x_3 \\ \vdots \\ a_n &\to a_1 +\sum_{i=2}^nx_i \end{align} How can I write a program in Mathematica that does this automatically regardless of the number of variables ($$n$$ in the example above)?

It seems I need some kind of a "rule" to be used with ReplaceAll, but I don't know how to generate one (instead of writing it out directly, which is impossible not knowing the number of variables).

• Can you show a concrete example of a system to which you want to apply the substitution, and the desired result, in Mathematica code? Commented Dec 23, 2023 at 12:57
• For example, bds is a multi-var polynomial of a1, a2 and so on. I want to substitute the variables like what /. does. @MarcoB Commented Dec 23, 2023 at 13:09
• Never heard of the 'Buffalo Way'. Tried looking it up but all I got was a Brilliant.org article which I can't access and just redirects to their front page. Is this like adding slack variables? Could you not just use FindInstance or LinearOptimization or Reduce? Commented Dec 23, 2023 at 13:21
• Are you looking for something like n = 3;k = 0; NestList[# + x[++k] &, a1, n] ? Commented Dec 23, 2023 at 23:30

Using the idea of Accumulate as demonstrated by @Ulrich Neumann, but with Threaded instead of Join

Table[a[1], {i, 2, 5}] + Threaded[Accumulate[Table[x[i], {i, 2, 5}]]]


Edit: thanks to @kglr for spotting this

a[1] + Accumulate[Table[x[i], {i, 2, 5}]]

• (+1) Your solution using Threaded is the fastest, mate! :-) Commented Dec 23, 2023 at 23:06
• @E.Chan-López thanks. I had no idea about speed. Performance issues I guess :-)
– bmf
Commented Dec 24, 2023 at 0:37
• a[1] + Accumulate[Table[x[i], {i, 2, 5}]] gives the same output
– kglr
Commented Dec 25, 2023 at 19:00
• @kglr thanks a lot. edited the answer :-)
– bmf
Commented Dec 26, 2023 at 0:02

Use a replacement rule:

R = a[n_] -> a[1] + Sum[x[j], {j, 2, n}];

a[1] /. R
(*    a[1]    *)

a[5] /. R
(*    a[1] + x[2] + x[3] + x[4] + x[5]    *)


What about Accumulate?

Join[{a1}, Table[x[i], {i, 2, 5}]] // Accumulate;


Updated

FoldList[#1+x[#2]&, a[1], Range[2,4]]

(*

{a[1],
a[1]+x[2],
a[1]+x[2]+x[3],
a[1]+x[2]+x[3]+x[4]}
*)



(*
{a[1]->a[1],
a[2]->a[1]+x[2],
a[3]->a[1]+x[2]+x[3],
a[4]->a[1]+x[2]+x[3]+x[4]}

*)


If you want a set of rules suitable for using as substitutions in Mathematica, then something like this might give you what you want:

Buffalo[a_Symbol, x_Symbol, len_] := Table[a[i + 1] -> a[1] + Total[Array[x, i, 2]], {i, 0, len - 1}]

Buffalo[a, x, 5] // TableForm


Using the same format as @lericr's answer, but using FoldList:

Buffalo[a_Symbol, x_Symbol, len_] :=
(
lhs = Array[a, len];
rhs = FoldList[Plus, a[1], Array[x, len - 1, 2]];
)
Buffalo[a, x, 5] // TableForm


Using Reap and Sow:

Buffalo[a_Symbol, x_Symbol, len__Integer?Positive] := MapApply[Rule,
Transpose[
{
Map[a, Range[1, len]],
Part[
Reap[
Do[{Sow[a[1] + Total[Array[x, i, 2]]]},
{i, 0, len - 1}
]
],
-1, 1
]
}
]
];

Buffalo[a, x, 5] // TableForm


Another version of @ydd answer using FoldList:

Buffalo[a_, x_, l_] := Rule @@@ Transpose@{a /@ Range[1, l],
FoldList[#1 + x[#2] &, a[1], Range[2, l]]}

• Reap + Sow FTW!!!
– bmf
Commented Dec 24, 2023 at 0:57
• Thanks and happy coding, mate! :-) Commented Dec 24, 2023 at 1:03
Accumulate @ Array[If[# == 1, a, x] @ # &, 5]

Accumulate[Array[x, 5]] /. x[1] -> a[1]

Array[x, 5, 1, ReplaceAll[x[1] -> a[1]] @* Accumulate @* List]

g[1] = a[1]; g[i_] := x[i]; Accumulate @ Array[g, 5]


all give

{a[1], a[1] + x[2], a[1] + x[2] + x[3], a[1] + x[2] + x[3] + x[4],
a[1] + x[2] + x[3] + x[4] + x[5]}

a[1] + Prepend[0] @ Accumulate @ Rest @ Array[x, 5]