Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Function construction and also symmetric matrices

• To: mathgroup at smc.vnet.net
• Subject: [mg108539] Re: Function construction and also symmetric matrices
• From: Raffy <adraffy at gmail.com>
• Date: Mon, 22 Mar 2010 02:40:42 -0500 (EST)
• References: <hnva64$88k$1@smc.vnet.net> <hnvo3m$egu$1@smc.vnet.net>

On Mar 20, 12:46 am, "Diamond, Mark" <d... at dot.dot> wrote:
> Thank you Ray.
>
> Have you any thoughts about the second question?
>
> Cheers,
> Mark
>
> "Ray Koopman" <koop... at sfu.ca> wrote in message
>
> news:hnvo3m$egu$1 at smc.vnet.net...
>
>
>
> > On Mar 19, 12:47 am, "Diamond, Mark" <d... at dot.dot> wrote:
> >> I am trying to construct a number of symmetric matrices with unit
> >> diagonal and random numbers in the off-diagonal entries. The matrices
> >> are of steadily increasing size. I have been constructing the
> >> matrices from random vectors with the correct number of off-diagonal
> >> entries, so that for a 3x3 matrix I have:
>
> >> symmetricMatrix[L_,3] :=   (* I have changed lowercase "l"   *)
> >> {{1, L[[1]], L[[2]]},      (* to uppercase "L" throughout   =
 *)
> >>  {L[[1]], 1, L[[3]]},      (* to avoid confusing "l" and "1" *=
)
> >>  {L[[2]], L[[3]], 1}}
>
> >> symmetricMatrix[#,3]&/@RandomReal[{0,1},{10000,3}]
>
> >> or, for a 4x4 matrix
>
> >> symmetricMatrix[L_,6] :=
> >> {{1, L[[1]], L[[2]], L[[4]]},
> >>  {L[[1]], 1, L[[3]], L[[5]]},
> >>  {L[[2]], L[[3]], 1, L[[6]]},
> >>  {L[[4]], L[[5]], L[[6]], 1}}
>
> >> symmetricMatrix[#,6]&/@RandomReal[{0,1},{10000,6}]
>
> >> The method works but writing the function symmetricMatrix by hand
> >> error-prone for large matrices. ...
>
> >> My first question is whether I have overlooked a much better (i.e.,
> >> computationally faster) way of producing the matrices. Something
> >> which avoids all the calls to Part (e.g., L[[7]]) might be good.
>
> >> My second question relates not only to symmetric matrices but to a
> >> problem that I face frequently in other areas. Is there a way of
> >> constructing the symmetricMatrix function automatically? This is
> >> different from the question about a good way of constructing symmetric
> >> matrices. Here I am asking whether, given an appropriate matrix size,
> >> n, I can get Mathematica to create the static function in the form
> >> that I have written symmetricMatrix[3] and symmetricMatrix[6] ...
> >> so that, for example, if I enter
>
> >> makeStaticSymmetricMatrixFunctionForSize[3]
>
> >> and then enter
>
> >> ?makeSymmetricMatricFunction
>
> >> Mathematic will show me that there now exists a function like
>
> >> symmetricMatrix[L_,3] :=
> >> {{1, L[[1]], L[[2]]},
> >>  {L[[1]], 1, L[[3]]},
> >>  {L[[2]], L[[3]], 1}}
>
> >> ??
>
> >> I would appreciate any help or suggestions.
>
> >> Cheers,
> >> Mark Diamond
>
> > First, the solution to a slightly different problem.
>
> > Lix[i,j] = Lix[j,i] returns the linear index of row i, column j,
> > in a symmetric matrix whose nonredundant elements are numbered as
>
> > 1
> > 2  3
> > 4  5  6
> > 7  8  9 10
> > etc.
>
> > Lix[i_,j_] := #(#-1)/2 & @ Max[i,j] + Min[i,j]
>
> > With[{n = 6}, Table[Lix[i,j],{i,n},{j,n}] ]
>
> > {{ 1,  2,  4,  7, 11, 16},
> > { 2,  3,  5,  8, 12, 17},
> > { 4,  5,  6,  9, 13, 18},
> > { 7,  8,  9, 10, 14, 19},
> > {11, 12, 13, 14, 15, 20},
> > {16, 17, 18, 19, 20, 21}}]
>
> > This will create a symmetric random matrix:
>
> > With[{n = 4}, Table[#[[Lix[i,j]]],{i,n},{j,n}]& @
> >              Table[ Random[Integer,9],{n(n+1)/2}] ]
>
> > {{2, 7, 0, 9},
> > {7, 1, 0, 0},
> > {0, 0, 8, 5},
> > {9, 0, 5, 0}}]
>
> > Now to your problem. The easiest solution is to
> > insert the diagonals into the list of offidagonals.
>
> > symat[L_,n_,d_] := Table[#[[Lix[i,j]]],{i,n},{j,n}]& @
> >                   Insert[L,d,Table[{i*i+i},{i,0,n-1}]=
/2+1]
>
> > symat[Range@15, 6, 0]
>
> > {{ 0,  1,  2,  4,  7, 11},
> > { 1,  0,  3,  5,  8, 12},
> > { 2,  3,  0,  6,  9, 13},
> > { 4,  5,  6,  0, 10, 14},
> > { 7,  8,  9, 10,  0, 15},
> > {11, 12, 13, 14, 15,  0}}

First Idea:

ClearAll[symMat1];
symMat1[v_] :=
  With[{n = (1 + Sqrt[1 + 8 Length[v]])/2},
   With[{m =
       PadRight[
        Table[Take[v, i*(i - 1)/2 + {1, i}], {i, 0, n - 1}], {n, n},
        0]},
     m + Transpose[m] + IdentityMatrix[n]] /; IntegerQ[n]];

Improved Idea:

ClearAll[symMat2];
symMat2[v_] :=
  With[{n = (1 + Sqrt[1 + 8 Length[v]])/2},
   SparseArray[
     Reap[Fold[
        Function[{i, w},
         Do[With[{x = v[[i + j]]}, Sow[{1 + w, j} -> x];
           Sow[{j, 1 + w} -> x]], {j, w}]; i + w], 0,
        Range[n - 1]]][[2, 1]], {n, n}, 1] /; IntegerQ[n]];

Function Generator:

ClearAll[symMatFunc];
symMatFunc[n_Integer /; n > 0] :=
  Module[{h},
   Evaluate@
      Normal@SparseArray[
        Flatten@Rest@
          Reap[Fold[
            Function[{i, w},
             Do[With[{x = h[#, i + j]}, Sow[{1 + w, j} -> x];
               Sow[{j, 1 + w} -> x]], {j, w}]; i + w], 0,
            Range[n - 1]]], {n, n}, 1] & /. h -> Part];


symMatFunc[4]  === {
{1, #1[[1]], #1[[2]], #1[[4]]},
{#1[[1]], 1, #1[[3]], #1[[5]]},
{#1[[2]], #1[[3]], 1, #1[[6]]},
{#1[[4]], #1[[5]], #1[[6]], 1}} &

I'm sure there are cleaner ways to do this, but I thought this method
was kinda fun (using SparseArray for diagonal and Fold to generate the
indices.)