3
$\begingroup$

I am interested in the relationship between the Pearson correlation coefficients and the permutations of two random number sequences.

An initial Mathematica study is as below:

SeedRandom[1]
(data=RandomReal[1,{30,2}])//MatrixForm;
Correlation[data[[All,1]],data[[All,2]]]
Correlation[Sort@data[[All,1]],data[[All,2]]]
Correlation[Sort@data[[All,1]],Sort@data[[All,2]]]
Correlation[Sort@data[[All,1]],Sort[#,Greater]&@data[[All,2]]]

Outputs are:

-0.0615673 (*correlation coefficient of the original order*)
0.209375 (*sorting the first sequence*)
0.981946 (*sorting both the two sequences in the same order*)
-0.964172 (*sorting both the two sequences in converse order*)

My questions are:

  1. How can I find the permutation(s) when the correlation coefficient of the two sequences is the closest to zero?

  2. Given a number between the minimum (-0.964172 for this case) and the maximum (0.981946 for this case), how to find the right permutations of which the correlation coefficient of the two sequences are closest to the given number?

I tried to use Permutations and then search(or Optimize/NMinimize) in the permutation space, but always encountered into SystemException["MemoryAllocationFailure"]

$\endgroup$
3
$\begingroup$

It's not surprising that you receive SystemException["MemoryAllocationFailure"] because 30!=265252859812191058636308480000000.

SeedRandom[1];
data = RandomReal[1, {30, 2}];

Correlation[data[[;; , 1]], data[[;; , 2]]]

-0.0615673

Okay. Now we will searching permutation when the correlation coefficient of the two sequences is the closest to zero.

enter image description here

We can reformulate the problem as searching covariance closest to zero.

n1 = (# - Mean[#]) &@data[[;; , 1]];
n2 = (# - Mean[#]) &@data[[;; , 2]];
u = Table[Unique["x"], {30}, {30}];

sol = NMinimize[
    {
     n1.u.n2,
     n1.u.n2 >= 0.,
     Thread[Total[u[[#]]] == 1] & /@ Range[30],
     Thread[Total[u[[;; , #]]] == 1] & /@ Range[30],
     Thread[Flatten[u] > 0],
     Thread[Flatten[u] \[Element] Integers]
     },
    Flatten[u]
    ]; // AbsoluteTiming

(* {25.4994, Null} *)

perm = (u /. sol[[2]]).n2 + Mean[data[[;; , 2]]];

Correlation[data[[;; , 1]], perm]

2.34369*10^-7

And now answer on your second question. For example, we would like to see correlation closest to 0.2.

k = 0.2*29*StandardDeviation[data[[;; , 1]]]*StandardDeviation[data[[;; , 2]]]

Number 29 is from the covariance formula:

enter image description here

Length[v1] = 30 and minus 1 equals 29.

sol2 = NMinimize[
    {
     n1.u.n2,
     n1.u.n2 >= k,
     Thread[Total[u[[#]]] == 1] & /@ Range[30],
     Thread[Total[u[[;; , #]]] == 1] & /@ Range[30],
     Thread[Flatten[u] > 0],
     Thread[Flatten[u] \[Element] Integers]
     },
    Flatten[u]
    ]; // AbsoluteTiming

(* {10.0725, Null} *)

perm = (u /. sol2[[2]]).n2 + Mean[data[[;; , 2]]];

Correlation[data[[;; , 1]], perm]

0.200001

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.