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