How to create non-rectangular array with Array?

Question

From the answers to this question, I learned that the recommended way to construct a symbolic sum of terms in an expression is to use Array.

But I'm having a little trouble creating a non-rectangular array with it. For example, how do I emulate something like

Table[f[i,j],{i,1,5},{j,i,5}]
Sum[f[i,j],{i,1,5},{j,i,5}]

which have pyramidal forms?

Is Array simply inflexible about the shape of the output. If so, what is the recommended method to construct a non-rectangular array?

---

I suppose I can nest Array like so:

Array[Function[{i}, Array[f[i, #] &, 6 - i, i, Plus]], 5, 1, Plus]

But I have to use a named function with argument i in order for it to work. Is it possible to achieve the same result using anonymous functions only?

Answer 1

Using the vanishing function ( ##&[]) or Unevaluated @ Sequence[] combined with If or Piecewise:

Array[If[# <= #2, f@##, ## &[]] &, {3, 3}, 1, foo]

foo[foo[f[1, 1], f[1, 2], f[1, 3]], foo[f[2, 2], f[2, 3]], foo[f[3, 3]]]

Array[If[# <= #2, f @ ##, ## &[]] &, {3, 3}, 1, Plus]

f[1, 1] + f[1, 2] + f[1, 3] + f[2, 2] + f[2, 3] + f[3, 3]

Array[If[# <= #2, f @ ##, ## &[]] &, {3, 3}, 1, Times]

f[1, 1] f[1, 2] f[1, 3] f[2, 2] f[2, 3] f[3, 3]

Alternatively, use ##&[] as the default value in Piecewise:

Array[Piecewise[{{f @ ##, # <= #2}}, ## &[]] &, {3, 3}, 1, Plus]

f[1, 1] + f[1, 2] + f[1, 3] + f[2, 2] + f[2, 3] + f[3, 3]

Array[Piecewise[{{f @ ##, # <= #2}}, ## &[]] &, {3, 3}, 1, Times]

f[1, 1] f[1, 2] f[1, 3] f[2, 2] f[2, 3] f[3, 3]

In both cases, using Unevaluated @ Sequence[] in place of ##&[] also works.

Answer 2

Your Table command doesn't produce an array,

Table[f[i, j], {i, 1, 5}, {j, i, 5}] // ArrayQ
(* False *)

Array seems like wrong tool for this job, but with the versatility of the language we can make it work.

Array is going to make a rectangular array, so if we want to drop terms we can set them equal to Nothing if we want a list structure in the end, or to 0 if we want them to drop out of a sum. You could do this either by adding a DownValue for f,

f[i_, j_] /; i > j := 0;
Array[f, {3, 3}, 1, Plus]
(* f[1, 1] + f[1, 2] + f[1, 3] + f[2, 2] + f[2, 3] + f[3, 3] *)

or by using a replacement rule,

ClearAll@f
Array[f, {3, 3}] /. f[i_, j_] /; i > j :> Nothing
(* {{f[1, 1], f[1, 2], f[1, 3]}, {f[2, 2], f[2, 3]}, {f[3, 3]}} *)

For this task though, any performance gain you get from Array is lost due to the evaluation step of throwing away half the values. Table still seems like the right choice for constructing a non-rectangular array:

nmax = 500;

sum1 = 
   Array[f, {nmax, nmax}, 1, Plus] /. 
    f[i_, j_] /; i > j :> 0; // RepeatedTiming
(* {0.309, Null} *)

sum2 = 
   Array[If[# <= #2, f@##, ## &[]] &, {nmax, nmax}, 1, 
    Plus]; // RepeatedTiming
(* {0.31, Null} *)

sum3 = 
   Plus @@ Flatten[
     Table[f[i, j], {i, 1, nmax}, {j, i, nmax}]]; // RepeatedTiming
(* {0.057, Null} *)

SameQ[sum1, sum2, sum3]
(* True *)