Best way to create symmetric matrices

Proposed solution

If fn[i,j] produces the $(i,j)^{th}$ element, then

makeSym[size_, fn_] := Module[
  {rtmp},
  rtmp = Table[
    fn[i, j],
    {i, 1, size},
    {j, 1, i}];
  MapThread[
   Join,
   {rtmp, Rest /@ Flatten[rtmp, {{2}, {1}}]}
   ]
  ]

does what you want.

Example

makeSym[5, Subscript[f, #1, #2] &] // MatrixForm

Mathematica graphics

How does it work?

Idea

Produce half the matrix, then do a "ragged transpose" and finally zip the results together.

Step by step

First, we construct half the matrix with a Table: For an example size of 5, we have

With[{size = 5},rtmp=Table[fn[i, j], {i, 1, size}, {j, 1, i}]]

(*
{ {fn[1, 1]}, 
  {fn[2, 1], fn[2, 2]}, 
  {fn[3, 1], fn[3, 2], fn[3, 3]}, 
  {fn[4, 1], fn[4, 2], fn[4, 3], fn[4, 4]}, 
  {fn[5, 1], fn[5, 2], fn[5, 3], fn[5, 4], fn[5, 5]}}
*)

Next, use the form of Flatten described here and in the docs to do a "ragged transpose":

Flatten[rtmp, {{2}, {1}}]
(*
{ {fn[1, 1], fn[2, 1], fn[3, 1], fn[4, 1], fn[5, 1]}, 
  {fn[2, 2], fn[3, 2], fn[4, 2], fn[5, 2]}, 
  {fn[3, 3], fn[4, 3], fn[5, 3]}, 
  {fn[4, 4], fn[5, 4]}, 
  {fn[5, 5]}}
*)

then drop the first element of each (to avoid duplicating it), by mapping Rest:

Rest /@ Flatten[rtmp, {{2}, {1}}]

(*
{ {fn[2, 1], fn[3, 1], fn[4, 1], fn[5, 1]}, 
  {fn[3, 2], fn[4, 2], fn[5, 2]}, 
  {fn[4, 3], fn[5, 3]}, 
  {fn[5, 4]}, 
  {}}
*)

And finally, zip together the corresponding pieces (ie, the $i^{th}$ line of the last result with the $i^{th}$ of rtmp), using MapThread:

MapThread[
 Join,
 {rtmp, Rest /@ Flatten[rtmp, {{2}, {1}}]}
 ]

(*
{ {fn[1, 1], fn[2, 1], fn[3, 1], fn[4, 1], fn[5, 1]}, 
  {fn[2, 1], fn[2, 2], fn[3, 2], fn[4, 2], fn[5, 2]}, 
  {fn[3, 1], fn[3, 2], fn[3, 3], fn[4, 3], fn[5, 3]}, 
  {fn[4, 1], fn[4, 2], fn[4, 3], fn[4, 4], fn[5, 4]}, 
  {fn[5, 1], fn[5, 2], fn[5, 3], fn[5, 4], fn[5, 5]}}
*)

Borrowing liberally from acl's answer:

sim = Join[#, Rest /@ # ~Flatten~ {2}, 2] & @ Table[i ~#~ j, {i, #2}, {j, i}] &;

sim[Subscript[x, ##] &, 5] // Grid

$\begin{array}{ccccc} x_{1,1} & x_{2,1} & x_{3,1} & x_{4,1} & x_{5,1} \\ x_{2,1} & x_{2,2} & x_{3,2} & x_{4,2} & x_{5,2} \\ x_{3,1} & x_{3,2} & x_{3,3} & x_{4,3} & x_{5,3} \\ x_{4,1} & x_{4,2} & x_{4,3} & x_{4,4} & x_{5,4} \\ x_{5,1} & x_{5,2} & x_{5,3} & x_{5,4} & x_{5,5} \end{array}$

Trading efficiency for brevity:

sim2[f_, n_] := Max@## ~f~ Min@## & ~Array~ {n, n}

sim2[Subscript[f, ##] &, 5] // Grid

$\begin{array}{ccccc} x_{1,1} & x_{2,1} & x_{3,1} & x_{4,1} & x_{5,1} \\ x_{2,1} & x_{2,2} & x_{3,2} & x_{4,2} & x_{5,2} \\ x_{3,1} & x_{3,2} & x_{3,3} & x_{4,3} & x_{5,3} \\ x_{4,1} & x_{4,2} & x_{4,3} & x_{4,4} & x_{5,4} \\ x_{5,1} & x_{5,2} & x_{5,3} & x_{5,4} & x_{5,5} \end{array}$


Just for fun, here's a method for fast vectorized (Listable) functions such as your "cheap f" test, showing what's possible if you keep everything packed. (Cos function given a numeric argument so that it evaluates.)

f1 = LowerTriangularize[#, -1] + Transpose@LowerTriangularize[#] & @
       ConstantArray[Range@#, #] &;

f2 = {#, Reverse[(Length@# + 1) - #, {1, 2}]} &;

f3 = # @@ f2@f1 @ #2 &;

f3[Cos[N@# * #2] &, 500]  // timeAvg

sim[Cos[N@# * #2] &, 500] // timeAvg

0.00712

0.1436


A simple and clean way to generate symmetric matrices (in general) would be the following:

SparseArray[{{i_, j_} :> f[i, j] /; i >= j, {i_, j_} :> f[j, i]}, 5] // Normal

(* {{f[1, 1], f[2, 1], f[3, 1], f[4, 1], f[5, 1]}, 
    {f[2, 1], f[2, 2], f[3, 2], f[4, 2], f[5, 2]}, 
    {f[3, 1], f[3, 2], f[3, 3], f[4, 3], f[5, 3]}, 
    {f[4, 1], f[4, 2], f[4, 3], f[4, 4], f[5, 4]}, 
    {f[5, 1], f[5, 2], f[5, 3], f[5, 4], f[5, 5]}} *)

The Normal is necessary only if you don't want a SparseArray object (generally, it doesn't matter). If your function f is expensive, you can do something like

Table[{{i, j} -> #, {j, i} -> #} &@f[i, j], {i, 5}, {j, i}] // Flatten // SparseArray

which evaluates f only $N(N+1)/2$ times instead of $N^2$.