0
$\begingroup$

I tried using DeleteCases to delete elements in r1 where g2==0 to get a defined arithmetic mean for T.

\[Psi] = Sqrt[2] - 1;
\[Epsilon] = 0.001;
w = 40000;
f[\[Omega]_] := 
  N[Mean[Select[
     Flatten[Table[(Ceiling[n (\[Psi] - \[Epsilon])] + a)/n, {a, 1, 
        1000}, {n, 1, Round[(\[Omega])/(2^a)]}]], 
     Between[#, {\[Psi] - \[Epsilon], \[Psi] + \[Epsilon]}] &]]];
g1[x_] := (Max[Abs[f[x + 1] - f[x + 2]], Abs[f[x] - f[x + 1]]]);
g2[x_] := (Min[Abs[f[x + 1] - f[x + 2]], Abs[f[x] - f[x + 1]]]);
r1 = DeleteCases[Flatten[Table[x, {x, 1, w}]], g2[#] == 0 &];
T = N[Mean[Table[g1[x]/g2[x], {x, r1}]]]

Instead, I get an error of division by zero.

How do we delete all elements in r1 where g2==0 to get defined arithmetic mean for T?

$\endgroup$
3
  • 1
    $\begingroup$ The syntax used for DeleteCases in the definition of r1 is wrong. From the documentation, the proper syntax is DeleteCases[expr, pattern], but g2[#] == 0& is not a pattern. The pattern would be _?(g2[#] == 0&). Calculation of g2 is slow. To prevent calculating g2 more than once for a given value, use memorization, i.e., g2[x_] := g2[x] = ... For a minimal working example do not use such large values of w. $\endgroup$
    – Bob Hanlon
    Jul 4, 2021 at 0:35
  • $\begingroup$ @BobHanlon Thanks! Is it possible to put this in your answer. I will award you with 15 points. $\endgroup$
    – Arbuja
    Jul 4, 2021 at 0:57
  • $\begingroup$ @BobHanlon However... I'd like to know if my average converges for larger values. How do we do this? $\endgroup$
    – Arbuja
    Jul 4, 2021 at 1:04

1 Answer 1

2
$\begingroup$
Clear["Global`*"]

ψ = Sqrt[2] - 1;
ϵ = 0.001;

I have used a smaller value of w to reduce the time required to evaluate. After you have finalized the code, increase w to whatever required value.

w = 4000;

To improve efficiency, use memorization for f and g2

f[ω_] := f[ω] =
   N[Mean[
     Select[
      Flatten[
       Table[(Ceiling[n (ψ - ϵ)] + a)/n, {a, 1, 1000}, {n, 1, 
         Round[(ω)/(2^a)]}]], 
      Between[#, {ψ - ϵ, ψ + ϵ}] &]]];
g1[x_] := (Max[Abs[f[x + 1] - f[x + 2]], Abs[f[x] - f[x + 1]]]);
g2[x_] := g2[x] =
   (Min[Abs[f[x + 1] - f[x + 2]], Abs[f[x] - f[x + 1]]]);

For some values of x, g2 does not evaluate to a number.

{g2[1024], g2[1025]}

(* {Min[0, Abs[-0.415205 + Mean[{}]]], 
    Min[0., Abs[-0.415205 + Mean[{}]]]} *)

You need to determine why this occurs. I will just delete those cases as well as when g2[x] == 0

r1 = DeleteCases[
   Flatten[Table[x, {x, 1, w}]], _?(g2[#] == 0 || ! NumericQ[g2[#]] &)];

Length@r1

(* 565 *)

T = N[Mean[Table[g1[x]/g2[x], {x, r1}]]]

(* 8.05429 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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