как создать график планарного множества Кантора в математике

Мне интересно, может ли кто-нибудь помочь мне построить Канторовская пыль на плоскости в Mathematica. Это связано с набором Cantor.

Большое спасибо.

ИЗМЕНИТЬ

Я действительно хотел иметь что-то вроде этого:

введите здесь описание изображения


wolfram-mathematica
person Qiang Li    schedule 08.07.2011    source источник

Ответы (3)


arrow_upward
5
arrow_downward

Вот наивный и, вероятно, не очень оптимизированный способ воспроизведения графики для конструкции троичного множества Кантора:

cantorRule = Line[{{a_, n_}, {b_, n_}}] :> 
  With[{d = b - a, np = n - .1}, 
       {Line[{{a, np}, {a + d/3, np}}], Line[{{b - d/3, np}, {b, np}}]}]

Graphics[{CapForm["Butt"], Thickness[.05], 
  Flatten@NestList[#/.cantorRule&, Line[{{0., 0}, {1., 0}}], 6]}]

Тернарный набор Кантора

Чтобы сделать пыль Кантора, используя те же правила замены, мы берем результат на определенном уровне , например 4:

dust4=Flatten@Nest[#/.cantorRule&,Line[{{0.,0},{1.,0}}],4]/.Line[{{a_,_},{b_,_}}]:>{a,b}

и взять кортежи из него

dust4 = Transpose /@ Tuples[dust4, 2];

Затем мы просто рисуем прямоугольники

Graphics[Rectangle @@@ dust4]

введите здесь описание изображения

Редактировать: канторская пыль + квадраты

Изменены спецификации -> Новое, но похожее решение (все еще не оптимизированное).
Установите n как положительное целое число и выберите любое подмножество 1,...,n, затем

n = 3; choice = {1, 3};
CanDChoice = c:CanD[__]/;Length[c]===n :> CanD[c[[choice]]];
splitRange = {a_, b_} :> With[{d = (b - a + 0.)/n}, 
                              CanD@@NestList[# + d &, {a, a + d}, n - 1]];

cantLevToRect[lev_]:=Rectangle@@@(Transpose/@Tuples[{lev}/.CanD->Sequence,2])

dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 4] // Rest;

Graphics[{FaceForm[LightGray], EdgeForm[Black], 
  Table[cantLevToRect[lev], {lev, Most@dust}], 
  FaceForm[Black], cantLevToRect[Last@dust /. CanDChoice]}]

больше пыли

Вот графика для

n = 7; choice = {1, 2, 4, 6, 7};
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 2] // Rest;

а все остальное то же самое:

введите здесь описание изображения

person Simon    schedule 09.07.2011
comment
+1 и спасибо. Я действительно хотел иметь сюжет, как тот, который я прикрепил здесь. Не могли бы вы помочь с этим? Кажется, что получить такой сюжет сложнее. - person Qiang Li; 09.07.2011
comment
большое спасибо. Мне нужно некоторое объяснение здесь. Прежде всего, я думаю, что np = n - .1 должно быть np = n - 1, не так ли? Просто озадачен тем, почему код все еще дает правильные результаты? Также как насчет этой строки cantorRule = {CanD[x_,y_,z_]:>(CanD[x,z]/.cantorRule), {a_,b_}:>With[{d=(b-a)/3.},CanD@@NestList[#+d&,{a,a+d},2]]};? я не могу до конца понять... - person Qiang Li; 11.07.2011
comment
@QiangLi: np=n-.1 нужно было просто получить правильный интервал по оси Y на первом изображении. Эти термины отбрасываются во втором изображении, и для создания третьего изображения используется другое правило. - person Simon; 11.07.2011
comment
@QiangLi: Что касается последнего cantorRule, он делает две вещи. Второй член принимает пару координат x и возвращает последовательность, которая делит ее на 3 равные части. Они используются для рисования пустых квадратов. Затем 1-е правило берет эти три части и отбрасывает средний член - это то, что мешает всему этому быть равномерно заполненным квадратами. Обратите внимание, что в команде Graphics мне приходится вручную отбрасывать средний член при рисовании последних заполненных квадратов. - person Simon; 11.07.2011
comment
@QiangLi: я изменил свой код, чтобы сделать его более понятным и гибким. - person Simon; 11.07.2011
comment
Кстати: те же правила и NestList можно использовать для создания анимации. Например. {1,3,5}анимация. (Когда прямоугольники становятся слишком маленькими, они не очень хорошо рисуются...) - person Simon; 11.07.2011

arrow_upward
3
arrow_downward

Однажды можно использовать следующий подход. Определите функцию Кантора:

cantorF[r:(0|1)] = r;
cantorF[r_Rational /; 0 < r < 1] := 
 Module[{digs, scale}, {digs, scale} = RealDigits[r, 3];
  If[! FreeQ[digs, 1], 
   digs = Append[TakeWhile[Most[digs]~Join~Last[digs], # != 1 &], 1];];
  FromDigits[{digs, scale}, 2]]

Затем сформируйте пыль, вычислив разницу F[n/3^k]-F[(n+1/2)/3^k]:

With[{k = 4}, 
  Outer[Times, #, #] &[
   Table[(cantorF[(n + 1/2)/3^k] - cantorF[(n)/3^k]), {n, 0, 
     3^k - 1}]]] // ArrayPlot

введите здесь описание изображения

person Sasha    schedule 09.07.2011

arrow_upward
1
arrow_downward

Мне нравятся рекурсивные функции, поэтому

cantor[size_, n_][pt_] :=
  With[{s = size/3, ct = cantor[size/3, n - 1]},
    {ct[pt], ct[pt + {2 s, 0}], ct[pt + {0, 2 s}], ct[pt + {2 s, 2 s}]}
  ]

cantor[size_, 0][pt_] := Rectangle[pt, pt + {size, size}]

drawCantor[n_] := Graphics[cantor[1, n][{0, 0}]]

drawCantor[5]

Объяснение: size — это длина ребра квадрата, в который помещается набор. pt - это {x,y} координаты нижнего левого угла.

person Szabolcs    schedule 09.07.2011
comment
Красиво и чисто +1! Кроме того, достаточно просто модифицировать, чтобы использовать произвольные шаблоны деления (анимация, созданная из кода). - person Simon; 11.07.2011