2
$\begingroup$

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]

enter image description here

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?

$\endgroup$
2
$\begingroup$

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

1/7 Cantor set

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

intersection intervals of a Cantor set and a subdivision of [0,1]

$\endgroup$
2
  • $\begingroup$ Why does it show 72 intervals? Shouldn't it be less than 21? I would expect $m^{\prime}$ intervals, out of $m$ intervals, that intersect with the cantor set I defined. $\endgroup$ – RajanArak Jul 8 '20 at 15:51
  • $\begingroup$ It seems I misinterpreted your requirements, then. Are the intervals returned by With[{m = 21, r = 3}, Sequence @@@ (IntervalIntersection[Interval @@ cantormesh[r, 7], Interval[#]] & /@ Partition[Subdivide[m], 2, 1])] what you expected them to be? How about With[{m = 21, r = 3}, Count[IntervalIntersection[Interval @@ cantormesh[r, 7], Interval[#]] & /@ Partition[Subdivide[m], 2, 1], Except[Interval[]]]]? $\endgroup$ – J. M.'s ennui Jul 9 '20 at 4:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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