How to partition $[0,1]$ into $m$ equal sub-intervals and count the number of sub-intervals that intersect with my cantor set?

Question

Suppose I define my cantor set as

 cantor = {a_, 
    b_} :> {{a, a + (b - a)*1/7}, {a + (b - a)*2/7, 
     a + (b - a)*3/7}, {a + (b - a)*4/7, 
     a + (b - a)*5/7}, {a + (b - a)*6/7, b}};
CantorRegion[c_Integer?NonNegative] := 
 Module[{ints}, 
  ints = Flatten[
    Nest[Flatten[Map[Function[s, s /. cantor], #], 1] &, {{0, 1}}, c]]]
ListPlot[Table[{CantorRegion[3][[c]], 0}, {c, 1, 
   Length[CantorRegion[3]]}]]
generateA[n_Integer] := CantorRegion[n]

How do we divide $[0,1]$ into $m$ sub-intervals of equal length and count the number of sub-intervals that intersect with my cantor set?

My attempt:

In[11]:= partition[a_List, s_] := Module[{f, r}, f[{}, x_] := {x};
  f[l_List, x_] := If[x - l[[1]] < s, Append[l, x], Sow[l]; {x}];
  r = Reap[Fold[f, {}, a]];
  Append[r[[2, 1]], r[[1]]]]
partition[{0, 1, 2, 7, 10, 11, 12}, 5]
(*{{0,1,2},{7,10,11},{12}}*)

Out[12]= {{0, 1, 2}, {7, 10, 11}, {12}}

Unfortunately for my cantor set

partition[Flatten[generateA[5]], 5]

I get the following:

Part::partw: Part 1 of {} does not exist.

Part::pkspec1: The expression {0,1/16807,2/16807,3/16807,4/16807,5/16807,6/16807,1/2401,2/2401,15/16807,16/16807,17/16807,18/16807,19/16807,20/16807,3/2401,4/2401,29/16807,30/16807,31/16807,32/16807,33/16807,34/16807,5/2401,6/2401,43/16807,44/16807,45/16807,46/16807,47/16807,48/16807,1/343,2/343,99/16807,100/16807,101/16807,102/16807,103/16807,104/16807,15/2401,16/2401,113/16807,114/16807,115/16807,116/16807,117/16807,118/16807,17/2401,18/2401,127/16807,<<1998>>} cannot be used as a part specification.

Question

How do we fix my code? Is there a better solution?

Edit: I tried J.M's technique and I don't see why the result is greater than $m$. For the time being I made another attempt.

P[m_] := Interval /@ Partition[Subdivide[m], 2, 1]
Total[Table[
  Sign[Total[
    Boole[Table[
      IntervalMemberQ[P[100][[s]], generateA[5][[g]]], {g, 1, 
       Length[generateA[5]]}]]]], {s, 1, 100}]]

But the calculation time is too long. In 30 minutes I get 48 out of 100 intervals.

Is there a better way of doing this?

Answer 1

Here's a Cantor generator I wrote a long time ago, which you might be interested in:

cantormesh[n_Integer?NonNegative, p_Integer: 3] := 
Nest[Replace[#, {x_?NumberQ, y_?NumberQ} :>
                Apply[Sequence, Partition[Subdivide[x, y, p], 2]], 1] &, {{0, 1}}, n]

For instance,

NumberLinePlot[Interval @@ cantormesh[2, 7],
               PlotRange -> {0, 1}, PlotStyle -> AbsolutePointSize[1]]

With that, here's a brute-force counting method:

With[{m = 21, r = 3}, (* m - number of subintervals; r - stage of Cantor iteration *)
     Length[Sequence @@@ (IntervalIntersection[Interval @@ cantormesh[r, 7],
                                               Interval[#]] & /@
                          Partition[Subdivide[m], 2, 1])]]
   78

If you don't want to include "degenerate" intervals where the endpoints are the same, you can do that too:

With[{m = 21, r = 3}, 
     Length[Select[Sequence @@@ (IntervalIntersection[Interval @@ cantormesh[r, 7],
                                                      Interval[#]] & /@
                                 Partition[Subdivide[m], 2, 1]), Apply[Unequal]]]]
   72

Of course, you can modify that code to visualize the intersections themselves:

With[{m = 21, r = 3}, 
     NumberLinePlot[IntervalIntersection[Interval @@ cantormesh[r, 7], Interval[#]] &
                    /@ Partition[Subdivide[m], 2, 1],
                    PlotRange -> {0, 1}, PlotStyle -> AbsolutePointSize[1]]]