Aide à calculer mon «écart»

Question

J'ai créé un "écart de distribution" où pour $\left\{a_1,...,a_k\right\}$ nous prenons tous la moyenne de toutes les combinaisons de $\frac{\min\left\{a_{i},a_{j}\right\}}{\max\left\{a_{i},a_j\right\}}$ ($i,j\in\left\{1,...,k\right\}$) sans répétitions, soustrayez par un et prenez la valeur absolue.

$$\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|$$

Pour l'infini $k$ nous prenons simplement

$$\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|$$

Cela fonctionne bien pour les valeurs de $a_i$ qui sont extrêmement petits.

Je veux appliquer cette déviation aux différences d'éléments dans la séquence suivante de $\left\{\frac{\ln(m)}{\ln(n)}:m\in\mathbb{N}_{>0},n\in\mathbb{N}_{>1}\right\}\cap[0,1]$. La séquence suivante est

$$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]$$

Pour chaque $d\in\mathbb{R}$, si nous listons $g(d)$ (Remarque $g(d)$ est fini) comme $\left\{a_1,...,a_{k}\right\}$ ($k$ est le nombre d'éléments de la liste en fonction de $d\in\mathbb{R}$) Nous prenons $|a_{i+1}-a_i|$ où $i,j\in\left\{1,...,k\right\}$. Mon écart de distribution comme$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|$$

Voici ma tentative de le faire

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}]

Malheureusement, le chargement prend trop de temps. Existe-t-il un moyen de raccourcir le temps? Mon code correspond-il à mes équations mathématiques?

Answer 1

Vous pouvez accélérer les calculs de votre équation initiale de plusieurs ordres de grandeur (avec des augmentations de vitesse toujours plus importantes pour des valeurs plus importantes de k) en utilisant Sortet 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 *)

Car k = 1000le rapport des timings est d'environ 1100.

Une addition:

Voici une formule générale pour votre index. (J'ai laissé de côté toute suppression des doublons car je suis un peu sceptique quant à l'utilité même sans le fait que les doublons posent des problèmes.)

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]}]]]

En utilisant une liste de nombres ci-dessus, l'indice d'écart est trouvé avec

deviation[x]
(* 0.278869 *)

Et le même index sur les différences se retrouve avec

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

En utilisant votre fonction, Fj'obtiens ce qui suit:

x = F[5]

deviation[x] // N
(* 0.470385 *)
deviation[Differences[x]] // N
(* 0.821658 *)