Deleting all elements in a list where the output of elements from a function is zero

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?

• 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. Jul 4, 2021 at 0:35
• @BobHanlon Thanks! Is it possible to put this in your answer. I will award you with 15 points. Jul 4, 2021 at 0:57
• @BobHanlon However... I'd like to know if my average converges for larger values. How do we do this? Jul 4, 2021 at 1:04

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 *)
`