7
$\begingroup$

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).

Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ Can you show a concrete example of a system to which you want to apply the substitution, and the desired result, in Mathematica code? $\endgroup$
    – MarcoB
    Commented Dec 23, 2023 at 12:57
  • $\begingroup$ For example, bds is a multi-var polynomial of a1, a2 and so on. I want to substitute the variables like what /. does. @MarcoB $\endgroup$
    – youthdoo
    Commented Dec 23, 2023 at 13:09
  • 1
    $\begingroup$ 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? $\endgroup$
    – flinty
    Commented Dec 23, 2023 at 13:21
  • $\begingroup$ Are you looking for something like n = 3;k = 0; NestList[# + x[++k] &, a1, n] ? $\endgroup$
    – LouisB
    Commented Dec 23, 2023 at 23:30

9 Answers 9

Reset to default
11
$\begingroup$

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

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]    *)
Improve this answer
$\endgroup$
10
$\begingroup$

What about Accumulate?

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

enter image description here

Improve this answer
$\endgroup$
9
$\begingroup$

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]} 
*) 


Thread[Array[a,4]->FoldList[#1+x[#2]&, a[1], Range[2,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]} 

*)
Improve this answer
$\endgroup$
8
$\begingroup$

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

enter image description here

Improve this answer
$\endgroup$
8
$\begingroup$

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]];
  Thread[lhs -> rhs]
  )
Buffalo[a, x, 5] // TableForm

Mathematica graphics

Improve this answer
$\endgroup$
8
$\begingroup$

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

enter image description here

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]]}
Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ Reap + Sow FTW!!! $\endgroup$
    – bmf
    Commented Dec 24, 2023 at 0:57
  • 1
    $\begingroup$ Thanks and happy coding, mate! :-) $\endgroup$
    – E. Chan-López
    Commented Dec 24, 2023 at 1:03
8
$\begingroup$ 
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]}
Improve this answer
$\endgroup$
0
$\begingroup$ 
a[1] + Prepend[0] @ Accumulate @ Rest @ Array[x, 5]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.