1
$\begingroup$

I created a "distribution deviation" where for $\left\{a_1,...,a_k\right\}$ we take all take the mean of all combinations of $\frac{\min\left\{a_{i},a_{j}\right\}}{\max\left\{a_{i},a_j\right\}}$ ($i,j\in\left\{1,...,k\right\}$) without repetitions, subtract by one and take the absolute value.

$$\left|1-\frac{1}{\sum\limits_{i=1}^{k-1}i}\sum_{j=2}^{k}\sum_{i=1}^{j-1}\frac{\min\left\{a_{i},a_{j}\right\}}{\max\left\{a_{i},a_{j}\right\}}\right|$$

For infinite $k$ we simply take

$$\left|1-\frac{2}{k(k-1)}\sum_{j=1}^{k}\sum_{i=1}^{j-1}\frac{\min\left\{a_{i},a_{j}\right\}}{\max\left\{a_{i},a_{j}\right\}}\right|$$

This works well for values of $a_i$ that are extremely small.

I want to apply this deviation to the differences of elements in the folner sequence of $\left\{\frac{\ln(m)}{\ln(n)}:m\in\mathbb{N}_{>0},n\in\mathbb{N}_{>1}\right\}\cap[0,1]$. The folner sequence is

$$g(d)=\left\{\frac{\ln(m)}{\ln(n)}:m\in\mathbb{N}_{>0},n\in\mathbb{N}_{>1},n\le d\right\}\cap[0,1]$$

For every $d\in\mathbb{R}$, if we list $g(d)$ (note $g(d)$ is finite) as $\left\{a_1,...,a_{k}\right\}$ ($k$ is the number of elements in the list depending on $d\in\mathbb{R}$) we take $|a_{i+1}-a_i|$ where $i,j\in\left\{1,...,k\right\}$. My distribution deviation as $d,k\to\infty$.

$$\lim_{k\to\infty}\left|1-\frac{2}{k(k-1)}\sum_{j=2}^{k}\sum_{i=1}^{j-1}\frac{\min\left\{a_{j+1}-a_{j},a_{i+1}-a_{i}\right\}}{\max\left\{a_{j+1}-a_{j},a_{i+1}-a_{i}\right\}}\right|$$

Here is my attempt to do this

F[d_] := Abs[
   Differences[
    DeleteDuplicates[
     Sort[Flatten[
       Table[Log[m]/Log[n], {n, 2, d}, {m, 1, Floor[n]}]]]]]];
G[d_] := Table[
  N[Min[F[d][[i]], F[d][[j]]]/Max[F[d][[i]], F[d][[j]]], 10], {j, 2, 
   Length[F[100]]}, {i, 1, j - 1}]

Unfortunately it takes too long to load. Is there a way to shorten the time? Does my code match my math equations?

$\endgroup$
2
$\begingroup$

You can speed up the calculations for your initial equation several orders of magnitude (with ever larger increases in speed for larger values of k) by using Sort and Accumulate:

(* Generate a random sample of positive numbers *)
k = 100;
SeedRandom[12345];
x = RandomVariate[ChiSquareDistribution[20], k];

(* Original equation *)
t1 = AbsoluteTiming[Abs[1 - (2/(k (k - 1))) Sum[Min[x[[i]], x[[j]]]/Max[x[[i]], x[[j]]],
  {j, 2, k}, {i, 1, j - 1}]]]
(* {0.0120628, 0.262134} *)

(* Updated equation *)
t2 = AbsoluteTiming[y1 = Sort[x]; y2 = Accumulate[y1]; 
  Abs[1 - (2/(k (k - 1))) Sum[y2[[j - 1]]/y1[[j]], {j, 2, k}]]]
(* {0.0001317, 0.262134} *)

(* Ratio of timings *)
t1[[1]]/t2[[1]]
(* 91.593 *)

For k = 1000 the ratio of timings is around 1,100.

Addition:

Here is a general formula for your index. (I have left off any removal of duplicates as I'm a bit skeptical about the usefulness even without the fact that duplicates cause problems.)

deviation[a_] := Module[{a1, a2},
  a1 = Sort[a, Less];
  a2 = Accumulate[a1];
  Abs[1 - (2/(Length[a] (Length[a] - 1))) Sum[a2[[j - 1]]/a1[[j]], {j, 2, Length[a]}]]]

Using a list of numbers from above the deviation index is found with

deviation[x]
(* 0.278869 *)

And the same index on the differences is found with

deviation[Differences[x]]
(* 1.62546 *)

Using your function F I get the following:

x = F[5]

F[5]

deviation[x] // N
(* 0.470385 *)
deviation[Differences[x]] // N
(* 0.821658 *)
$\endgroup$
  • $\begingroup$ I'm not sure if my equation matches my description. Can you double-check. $\endgroup$ – Arbuja Sep 2 '20 at 17:54
  • $\begingroup$ It would be good if you provided the code for your original equation. Then you could proceed to the adjustment for the differences which should be identical to the original equation - other than now you have k-1 differences. No need to create an equation specially for the differences. $\endgroup$ – JimB Sep 2 '20 at 18:55
  • $\begingroup$ F[d_] := Abs[ Differences[ DeleteDuplicates[ Sort[Flatten[ Table[Log[m]/Log[n], {m, 1, Floor[d]}, {n, 2, Floor[m]}]]]]]]; G[d_] := Flatten[ Table[N[Min[F[d][[i]], F[d][[j]], 10]/Max[F[d][[i]], F[d][[j]]], 10], {j, 2, Length[F[d]]}, {i, 1, j - 1}]]; N[1 - Mean[G[15]], 10]. Here is my original code. I applied my deviation to the Folner Sequence of $\left\{\frac{\ln(m)}{\ln(n)}:m\in\mathbb{N_{>1}},n\in\mathbb{N_{>2}}\right\}\cap[0,1]$. (Take $n<d\in\mathbb{R}^{+}$). Check if your code gives the same result. $\endgroup$ – Arbuja Sep 2 '20 at 20:10
  • $\begingroup$ You've got 3 different questions: (1) How to code the "deviation", (2) How to code when the differences are used, and (3) how to use the functions for the Folner sequence. The answer to (1) should tell you how to do the other 2 questions. $\endgroup$ – JimB Sep 2 '20 at 20:30
  • $\begingroup$ I am sure how to adjust your code.I should get .6542... instead I get .9999.... I believe it should be $\frac{2}{k(k-1)}$ but I am not sure what it should be instead. $\endgroup$ – Arbuja Sep 2 '20 at 21:09

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.