list manipulation - Approximating the density of $Scap[a,b]$ using a Folner Sequence of $A$, where $S subseteq A$?

Edit: I redid my code but it's still not working.

How do we use Mathematica to approximate

$$D(S\cap[a,b])=\lim_{n\to\infty}\frac{\left|S\cap{F_n\cap[a,b]}\right|}{\left|F_n\cap[a,b]\right|}$$

where $D$ is the density of $S\cap[a,b]$ (in $A\cap[a,b]$), $[a,b]$ is an interval for $a,b\in\mathbb{R}$, $F_n$ is the Folner Sequence of $A$, and $S\subseteq A$. For more information, click here (replace $G,X,i,g$ with $A,S,n,a$) and here.

$A$ is countable and dense in $\mathbb{R}$ and can be written as the operations of finite or infinite one-variable functions that, when defined on countable domains dense in $\mathbb{R}$, intersect with the integers.

Example:

$$A=\left\{\frac{m+\ln(w)}{2^{(p/q)}+\sqrt{z}}:m,p,q,z,w\in\mathbb{Z},2^{p/q}+\sqrt{z}\neq0,q\neq0,z>0,w>0\right\}$$

There are many Folner Sequence of $A$. In general, the most natural, "intuitive" sequence is calculated by restricting the whole set, and the variables of each function in the set, by $n$.

$$F_n=\left\{\frac{m+\ln(w)}{2^{(p/q)}+\sqrt{z}}:m,p,q,z\in\mathbb{Z},2^{p/q}+\sqrt{z}\neq0,q\neq0,z>0, w>0,\left|\frac{m+\ln(w)}{2^{(p/q)}+\sqrt{z}}\right|\le n,|m|\le n,|p|\le n,|q|\le n, |z| \le n, |w| \le n\right\}$$

$S$ can be written similarly to $A$ except it must be a subset.

Example:

$$S=\left\{\frac{m_1}{2^{(p_1/q_1)}+\sqrt{z_1}}:m_1,q_1,z_1\in\mathbb{Z},2^{(p_1/q_1)}+\sqrt{z_1}\neq0,q_1\neq0,z_1>0\right\}$$

I attempted to approximate $D(S\cap[0,1])$ when $S=\left\{\frac{m^2}{n^2}:m,n\in\mathbb{Z},n\neq 0\right\}$, $A=\mathbb{Q}$, $F_n=\left\{\frac{p}{2^k(2q+1)}:p,k,q\in\mathbb{Z},2^k \le n, |2q+1|\le n, \left|\frac{p}{2^k(2q+1)}\right|\le n\right\}$.

(In my code I replaced $A$ with A[x_,y_,z_,...] and $F_n$ with F[x_,y_,z_,...], $S$ with S[x_,y_,z_,...], and $D$ with d. I also set $a=0$ and $b=1$.)

I tried to list all elements of $F_n\cap[0,1]$ depending on $n$ and determine which elements in $S\cap[0,1]$ exist in $F_n\cap[0,1]$. Then I counted all elements where this holds and divided it by the total elements in $F_n\cap[0,1]$.

Unprotect[d]
Remove[d]

A[p_, k_, q_] := p/((2^k)*(2*q + 1))
F[p_, n_] := 
 Table[A[p, k, q], {k, 0, Floor[Log[2, n]]}, {q, 0, Floor[(n - 1)/2]}]
f[n_, a_, b_] := 
 p /. Table[
   Solve[a <= A[p, k, q] <= b, p, Integers], {k, 0, 
    Floor[Log[2, n]]}, {q, 0, Floor[(n - 1)/2]}]
Ff[n_, a_, b_] := 
 DeleteDuplicates[
  Flatten[Table[

    F[f[n, a, b][[v]][[u]], n][[v]][[u]], {v, 1, 
     Floor[Log[2, n]] + 1}, {u, 1, Floor[(n - 1)/2] + 1}]]]
S[j_, k_] := j^2/k^2
X[a_, b_, n_] := 
 Count[Boole[Resolve[Exists[{j, k}, S[j, k] == Ff[n, a, b]]]], 1]
Y[a_, b_, n_] := Count[Ff[n, a, b]]
d[n_, a_, b_] := N[(Y[a, b, S] - X[a, b, S])/Y[a, b, S]]
Ff[4, 1, 2]
X[1, 2, 4]
Y[1, 2, 4]

d[1, 2, 4]

Instead, I get

 During evaluation of In[629]:= Table::iterb: Iterator {v,1,1+Floor[Log[S]/Log[2]]} does not have appropriate bounds.

During evaluation of In[629]:= Table::iterb: Iterator {v,1,1+Floor[Log[S]/Log[2]]} does not have appropriate bounds.

During evaluation of In[629]:= Table::iterb: Iterator {v,1,1+Floor[Log[S]/Log[2]]} does not have appropriate bounds.

During evaluation of In[629]:= General::stop: Further output of Table::iterb will be suppressed during this calculation.


During evaluation of In[629]:= Exists::msgs: Evaluation of S[j,k]==Ff[S,2,4] generated message(s) {General::stop,Table::iterb}.

During evaluation of In[629]:= Exists::msgs: Evaluation of j^2/k^2==Table[F[f[<<3>>][[v]][[u]],S][[v]][[u]],{v,1,1+Floor[Log[S]/Log[<<1>>]]},{u,1,Floor[(S-1)/2]+1}] generated message(s) {Table::iterb}.

During evaluation of In[629]:= Exists::msgs: Evaluation of j^2/k^2==Table[F[f[<<3>>][[v]][[u]],S][[v]][[u]],{v,1,1+Floor[Log[S]/Log[<<1>>]]},{u,1,Floor[(S-1)/2]+1}] generated message(s) {Table::iterb}.

During evaluation of In[629]:= General::stop: Further output of Exists::msgs will be suppressed during this calculation.

Out[642]= 1.

Is there a better and faster method to solving my example? How do we generalize this for any $S\cap[a,b]$ and $A\cap[a,b]$?

Answer

This works and provides expected resulst as far as I'm aware:

Clear[A, F, f, p, Ff, S, X, Y, d, j, k];
A[p_, k_, q_] := p/((2^k)*(2*q + 1));
F[p_, n_] := 
  Table[A[p, k, q], {k, 0, Floor[Log[2, n]]}, {q, 0, 
    Floor[(n - 1)/2]}];
f[n_, a_, b_] := 

  p /. Table[
    Solve[a <= A[p, k, q] <= b, p, Integers], {k, 0, 
     Floor[Log[2, n]]}, {q, 0, Floor[(n - 1)/2]}];
Ff[n_, a_, b_] := DeleteDuplicates@Flatten@Table[
     F[f[n, a, b][[v]][[u]], n][[v]][[u]]
     , {v, 1, Floor[Log[2, n]] + 1}
     , {u, 1, Floor[(n - 1)/2] + 1}
     ];
S[j_, k_] := j^2/k^2;
X[n_, a_, b_] := 

  Count[Resolve[
      Exists[{j, k}, S[j, k] == # && {j, k} ∈ Integers]] & /@
     Ff[n, a, b], True];
Y[n_, a_, b_] := Length[Ff[n, a, b]];
d[n_, a_, b_] := N[(Y[n, a, b] - X[n, a, b])/Y[n, a, b]];
Ff[4, 1, 2]
X[4, 1, 2]
Y[4, 1, 2]
d[4, 1, 2]

{1,2,4/3,5/3,3/2,7/6,11/6,5/4,7/4,13/12,17/12,19/12,23/12}
1
13
0.923077