How to speed up the construction of a large matrix

Question

As a part of a physics problem that I'm working on, I need to construct a rather large matrix. The matrix is a real symmetric $2^{m}\times 2^{m}$ matrix for some integer $m$, which we would like to make as large as possible, though of course calculations become increasingly impractical for large $m$. My code for constructing the matrix is the following:

transfermatrixmag = IdentityMatrix[2^m];

For[k = 1, k <= 2^m, k++, 
 For[j = 1, j <= 2^m, j++, 
   Part[Part[transfermatrixmag, j], k] = 
     Product[
       Exp[
         (Part[Part[Tuples[{-1, 1}, m], j], n] * 
            Part[Part[Tuples[{-1, 1}, m], k], n] + 
          1/2 Part[Part[Tuples[{-1, 1}, m], j], n] *
            Part[Part[Tuples[{-1, 1}, m], j], n + 1 - m*KroneckerDelta[n, m]] + 
          1/2 Part[Part[Tuples[{-1, 1}, m], k], n] *
            Part[Part[Tuples[{-1, 1}, m], k], n + 1 - m*KroneckerDelta[n, m]])], 
       {n, 1, m}]]]

This is obviously very inefficient, as it does not, for example, take advantage of the symmetry of the matrix (which I have called transfermatrixmag here). But it seems to me that the more fundamental limitation is the fact that one must do a computation for each entry of the matrix, making the construction of the matrix painfully slow. For example with $m=10$ the code takes about 1035 seconds, whereas performing multiplications with the resulting matrix or diagonalizing it takes on the order of 1 second. I'm sure it's possible to make significant optimizations to this, but I'm not really sure where to start. Can anyone offer some advice?

Answer 1

J.M. commented with this much faster code:

transfermatrix[m_Integer?Positive] := With[{tup = Tuples[{-1, 1}, m]}, 
 Exp[Outer[Dot, tup, tup, 1] + Outer[Plus, #, #]/2 &[
  MapThread[Dot, {tup, RotateLeft /@ tup}]]]]

shrx provided a compiled version:

transfermatrixNC = Compile[{{m, _Integer}}, 
 With[{tup = Table[IntegerDigits[i, 2, m], {i, 0, 2^m - 1}]*2. - 1.}, 
  Exp[Outer[Dot, tup, tup, 1] + .5*Outer[Plus, #, #] &[
   MapThread[Dot, {tup, RotateLeft /@ tup}]]]], 
    CompilationTarget -> "C", RuntimeOptions -> "Speed"]

If machine precision is sufficient this is faster still:

transfermatrix[m_Integer] := With[{t = Transpose@N@Tuples[{-1, 1}, m]},
  Exp[Transpose[t].t + (Outer[Plus, #, #] &[Total[t RotateLeft[t/2]]])]]