Writing/simplify a procedure, formula, ...

Hello,

i have the problem to simplify a formula to calculate the correlation of a portfolio and another share. I can calculate it step by step, but if has to be possible, to write an universal formula. Even if anybody could only name the necessary command, it would be easier to find a clue for the solution.

I calculate the correlation with the formula

p=[(correlation 1xn-vector) x (VaR nx1 vector transpose)]/square root[(VaR 1xn-vector) x (R nxn correlation-matrix) x (VaR nx1-vector transpose)]

R is the correlation-matrix of 10 shares

R={{1, 0.2808, 0.3211, 0.1329, 0.2887, 0.4646, 0.3683, 0.2544, 0.1663, 
  0.2745}, {0.2808, 1, 0.3632, 0.3754, 0.3197, 0.5202, 0.4083, 0.2652,
   0.2225, 0.285}, {0.3211, 0.3632, 1, 0.3045, 0.4577, 0.5539, 0.4062,
   0.4089, 0.3118, 0.4914}, {0.1329, 0.3754, 0.3045, 1, 0.2911, 
  0.3297, 0.2492, 0.3412, 0.1141, 0.3737}, {0.2887, 0.3197, 0.4577, 
  0.2911, 1, 0.5293, 0.4529, 0.5554, 0.4132, 0.643}, {0.4646, 0.5202, 
  0.5539, 0.3297, 0.5239, 1, 0.5918, 0.4585, 0.3148, 0.4844}, {0.3683,
   0.4083, 0.4062, 0.2492, 0.4529, 0.5918, 1, 0.3787, 0.4705, 
  0.3896}, {0.2544, 0.2652, 0.4089, 0.3412, 0.5554, 0.4585, 0.3787, 1,
   0.3297, 0.6272}, {0.1663, 0.2225, 0.3118, 0.1141, 0.4132, 0.3148, 
  0.4705, 0.3297, 1, 0.3033}, {0.2745, 0.285, 0.4914, 0.3737, 0.643, 
  0.4844, 0.3896, 0.6272, 0.3033, 1}}

VaR ist the Value at risk vector of the 10 shares
VaR={{1, 2, 3, 4, 5, -1, -2, -3, -4, -5}}

korrelation12zu3 = ({{R[[1, 3]], 
      R[[2, 3]]}}.{{VaR[[1, 1]]}, {VaR[[1, 
       2]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]]}}.{{R[[1, 1]], 
       R[[1, 2]]}, {R[[2, 1]], 
       R[[2, 2]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}})

{{0.423316}}

korrelation123zu4 = ({{R[[1, 4]], R[[2, 4]], 
      R[[3, 4]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
       3]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]], 
       VaR[[1, 3]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]]}, {R[[2, 1]], 
       R[[2, 2]], R[[2, 3]]}, {R[[3, 1]], R[[3, 2]], 
       R[[3, 3]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}})

{{0.388424}}

korrelation1234zu5 = ({{R[[1, 5]], R[[2, 5]], R[[3, 5]], 
      R[[4, 5]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}, {VaR[[
       1, 4]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]], VaR[[1, 3]], 
       VaR[[1, 4]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]], 
       R[[1, 4]]}, {R[[2, 1]], R[[2, 2]], R[[2, 3]], 
       R[[2, 4]]}, {R[[3, 1]], R[[3, 2]], R[[3, 3]], 
       R[[3, 4]]}, {R[[4, 1]], R[[4, 2]], R[[4, 3]], 
       R[[4, 4]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}})

{{0.481585}}

korrelation12345zu6 = ({{R[[1, 6]], R[[2, 6]], R[[3, 6]], R[[4, 6]], 
      R[[5, 6]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}, {VaR[[
       1, 4]]}, {VaR[[1, 5]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]], 
       VaR[[1, 3]], VaR[[1, 4]], VaR[[1, 5]]}}.{{R[[1, 1]], R[[1, 2]],
        R[[1, 3]], R[[1, 4]], R[[1, 5]]}, {R[[2, 1]], R[[2, 2]], 
       R[[2, 3]], R[[2, 4]], R[[2, 5]]}, {R[[3, 1]], R[[3, 2]], 
       R[[3, 3]], R[[3, 4]], R[[3, 5]]}, {R[[4, 1]], R[[4, 2]], 
       R[[4, 3]], R[[4, 4]], R[[4, 5]]}, {R[[5, 1]], R[[5, 2]], 
       R[[5, 3]], R[[5, 4]], 
       R[[5, 5]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}})

{{0.675596}}

korrelation12346zu7 = ({{R[[1, 7]], R[[2, 7]], R[[3, 7]], R[[4, 7]], 
      R[[5, 7]], 
      R[[6, 7]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}, {VaR[[
       1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}})/\[Sqrt]({{VaR[[1, 1]], 
       VaR[[1, 2]], VaR[[1, 3]], VaR[[1, 4]], VaR[[1, 5]], 
       VaR[[1, 6]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]], R[[1, 4]], 
       R[[1, 5]], R[[1, 6]]}, {R[[2, 1]], R[[2, 2]], R[[2, 3]], 
       R[[2, 4]], R[[2, 5]], R[[2, 6]]}, {R[[3, 1]], R[[3, 2]], 
       R[[3, 3]], R[[3, 4]], R[[3, 5]], R[[3, 6]]}, {R[[4, 1]], 
       R[[4, 2]], R[[4, 3]], R[[4, 4]], R[[4, 5]], 
       R[[4, 6]]}, {R[[5, 1]], R[[5, 2]], R[[5, 3]], R[[5, 4]], 
       R[[5, 5]], R[[5, 6]]}, {R[[6, 1]], R[[6, 2]], R[[6, 3]], 
       R[[6, 4]], R[[6, 5]], 
       R[[6, 6]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}})

{{0.511916}}

korrelation123467zu8 = ({{R[[1, 8]], R[[2, 8]], R[[3, 8]], R[[4, 8]], 
      R[[5, 8]], R[[6, 8]], 
      R[[7, 8]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}, {VaR[[
       1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 
       7]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]], VaR[[1, 3]], 
       VaR[[1, 4]], VaR[[1, 5]], VaR[[1, 6]], 
       VaR[[1, 7]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]], R[[1, 4]], 
       R[[1, 5]], R[[1, 6]], R[[1, 7]]}, {R[[2, 1]], R[[2, 2]], 
       R[[2, 3]], R[[2, 4]], R[[2, 5]], R[[2, 6]], 
       R[[2, 7]]}, {R[[3, 1]], R[[3, 2]], R[[3, 3]], R[[3, 4]], 
       R[[3, 5]], R[[3, 6]], R[[3, 7]]}, {R[[4, 1]], R[[4, 2]], 
       R[[4, 3]], R[[4, 4]], R[[4, 5]], R[[4, 6]], 
       R[[4, 7]]}, {R[[5, 1]], R[[5, 2]], R[[5, 3]], R[[5, 4]], 
       R[[5, 5]], R[[5, 6]], R[[5, 7]]}, {R[[6, 1]], R[[6, 2]], 
       R[[6, 3]], R[[6, 4]], R[[6, 5]], R[[6, 6]], 
       R[[6, 7]]}, {R[[7, 1]], R[[7, 2]], R[[7, 3]], R[[7, 4]], 
       R[[7, 5]], R[[7, 6]], 
       R[[7, 7]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 
        7]]}})

{{0.545535}}

korrelation1234678zu9 = ({{R[[1, 9]], R[[2, 9]], R[[3, 9]], R[[4, 9]],
       R[[5, 9]], R[[6, 9]], R[[7, 9]], 
      R[[8, 9]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 3]]}, {VaR[[
       1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 7]]}, {VaR[[1, 
       8]]}})/\[Sqrt]({{VaR[[1, 1]], VaR[[1, 2]], VaR[[1, 3]], 
       VaR[[1, 4]], VaR[[1, 5]], VaR[[1, 6]], VaR[[1, 7]], 
       VaR[[1, 8]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]], R[[1, 4]], 
       R[[1, 5]], R[[1, 6]], R[[1, 7]], R[[1, 8]]}, {R[[2, 1]], 
       R[[2, 2]], R[[2, 3]], R[[2, 4]], R[[2, 5]], R[[2, 6]], 
       R[[2, 7]], R[[2, 8]]}, {R[[3, 1]], R[[3, 2]], R[[3, 3]], 
       R[[3, 4]], R[[3, 5]], R[[3, 6]], R[[3, 7]], 
       R[[3, 8]]}, {R[[4, 1]], R[[4, 2]], R[[4, 3]], R[[4, 4]], 
       R[[4, 5]], R[[4, 6]], R[[4, 7]], R[[4, 8]]}, {R[[5, 1]], 
       R[[5, 2]], R[[5, 3]], R[[5, 4]], R[[5, 5]], R[[5, 6]], 
       R[[5, 7]], R[[5, 8]]}, {R[[6, 1]], R[[6, 2]], R[[6, 3]], 
       R[[6, 4]], R[[6, 5]], R[[6, 6]], R[[6, 7]], 
       R[[6, 8]]}, {R[[7, 1]], R[[7, 2]], R[[7, 3]], R[[7, 4]], 
       R[[7, 5]], R[[7, 6]], R[[7, 7]], R[[7, 8]]}, {R[[8, 1]], 
       R[[8, 2]], R[[8, 3]], R[[8, 4]], R[[8, 5]], R[[8, 6]], 
       R[[8, 7]], 
       R[[8, 8]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 
        7]]}, {VaR[[1, 8]]}})

{{0.233015}}

korrelation12346789zu10 = ({{R[[1, 10]], R[[2, 10]], R[[3, 10]], 
      R[[4, 10]], R[[5, 10]], R[[6, 10]], R[[7, 10]], R[[8, 10]], 
      R[[9, 10]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
       3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 
       7]]}, {VaR[[1, 8]]}, {VaR[[1, 9]]}})/\[Sqrt]({{VaR[[1, 1]], 
       VaR[[1, 2]], VaR[[1, 3]], VaR[[1, 4]], VaR[[1, 5]], 
       VaR[[1, 6]], VaR[[1, 7]], VaR[[1, 8]], 
       VaR[[1, 9]]}}.{{R[[1, 1]], R[[1, 2]], R[[1, 3]], R[[1, 4]], 
       R[[1, 5]], R[[1, 6]], R[[1, 7]], R[[1, 8]], 
       R[[1, 9]]}, {R[[2, 1]], R[[2, 2]], R[[2, 3]], R[[2, 4]], 
       R[[2, 5]], R[[2, 6]], R[[2, 7]], R[[2, 8]], 
       R[[2, 9]]}, {R[[3, 1]], R[[3, 2]], R[[3, 3]], R[[3, 4]], 
       R[[3, 5]], R[[3, 6]], R[[3, 7]], R[[3, 8]], 
       R[[3, 9]]}, {R[[4, 1]], R[[4, 2]], R[[4, 3]], R[[4, 4]], 
       R[[4, 5]], R[[4, 6]], R[[4, 7]], R[[4, 8]], 
       R[[4, 9]]}, {R[[5, 1]], R[[5, 2]], R[[5, 3]], R[[5, 4]], 
       R[[5, 5]], R[[5, 6]], R[[5, 7]], R[[5, 8]], 
       R[[5, 9]]}, {R[[6, 1]], R[[6, 2]], R[[6, 3]], R[[6, 4]], 
       R[[6, 5]], R[[6, 6]], R[[6, 7]], R[[6, 8]], 
       R[[6, 9]]}, {R[[7, 1]], R[[7, 2]], R[[7, 3]], R[[7, 4]], 
       R[[7, 5]], R[[7, 6]], R[[7, 7]], R[[7, 8]], 
       R[[7, 9]]}, {R[[8, 1]], R[[8, 2]], R[[8, 3]], R[[8, 4]], 
       R[[8, 5]], R[[8, 6]], R[[8, 7]], R[[8, 8]], 
       R[[8, 9]]}, {R[[9, 1]], R[[9, 2]], R[[9, 3]], R[[9, 4]], 
       R[[9, 5]], R[[9, 6]], R[[9, 7]], R[[9, 8]], 
       R[[9, 9]]}}.{{VaR[[1, 1]]}, {VaR[[1, 2]]}, {VaR[[1, 
        3]]}, {VaR[[1, 4]]}, {VaR[[1, 5]]}, {VaR[[1, 6]]}, {VaR[[1, 
        7]]}, {VaR[[1, 8]]}, {VaR[[1, 9]]}})

{{0.337219}}

i hope anybody have an advice for me.
thx

This formula seems to exist, a first shot for it is your natural language input

p=[(correlation 1xn-vector) x (VaR nx1 vector transpose)]/square
root[(VaR 1xn-vector) x (R nxn correlation-matrix) x (VaR nx1-vector
transpose)]

the numerator is a scalar product (R . VaR), the denominator seems to be the square root of (VaR . R . VaR) only you have to select the elements which have to enter that … in accordance with your tedious handwriting!

In[1]:= Clear[R]
R = {{1, 0.2808, 0.3211, 0.1329, 0.2887, 0.4646, 0.3683, 0.2544, 0.1663, 0.2745},
{0.2808, 1, 0.3632, 0.3754, 0.3197, 0.5202, 0.4083, 0.2652, 0.2225, 0.285},
{0.3211, 0.3632, 1, 0.3045, 0.4577, 0.5539, 0.4062, 0.4089, 0.3118, 0.4914},
{0.1329, 0.3754, 0.3045, 1, 0.2911, 0.3297, 0.2492, 0.3412, 0.1141, 0.3737},
{0.2887, 0.3197, 0.4577, 0.2911, 1, 0.5293, 0.4529, 0.5554, 0.4132, 0.643},
{0.4646, 0.5202, 0.5539, 0.3297, 0.5239, 1, 0.5918, 0.4585, 0.3148, 0.4844},
{0.3683, 0.4083, 0.4062, 0.2492, 0.4529, 0.5918, 1, 0.3787, 0.4705, 0.3896},
{0.2544, 0.2652, 0.4089, 0.3412, 0.5554, 0.4585, 0.3787, 1, 0.3297, 0.6272},
{0.1663, 0.2225, 0.3118, 0.1141, 0.4132, 0.3148, 0.4705, 0.3297, 1, 0.3033},
{0.2745, 0.285, 0.4914, 0.3737, 0.643, 0.4844, 0.3896, 0.6272, 0.3033, 1}};

        (* VaR ist the Value at risk vector of the 10 shares. There is an extra list level in the original. *)
        VaR = {1, 2, 3, 4, 5, -1, -2, -3, -4, -5};
        
        (* Why R is not symmetric? A digit rotation happened. *)
        In[18]:= Position[R - Transpose[R], #] & /@ Flatten[Select[#, # != 0 &] & /@ (R - Transpose[R])]
        Out[18]= {{{5, 6}}, {{6, 5}}}

now it’s utterly easy, translate your formula into a module

In[51]:= Clear[koeckeritzKorrelator]
koeckeritzKorrelator[m_?MatrixQ, v_?VectorQ, d_Integer] := 
 Module[{m0 = m[[1 ;; (d - 1), 1 ;; (d - 1)]], v0 = Take[v, d - 1], r0 = m[[1 ;; (d - 1), d]]},
   (r0.v0)/Sqrt[v0.m0.v0]
 ] /; 2 < d <= Length[v] && Length[m] == Length[v]

and test it

In[53]:= koeckeritzKorrelator[R, VaR, #] & /@ Range[3, 10]
Out[53]= {0.423316, 0.388424, 0.481585, 0.675596, 0.511916, 0.545535, 0.233015, 0.337219}

thank you very much! :slight_smile: