• A 3 cartoon 3d fractal self-similar set as a Besicovitch-Ursell-Knopp->

    From Roger Bagula@21:1/5 to All on Tue Mar 26 12:34:12 2019
    The idea here was to get a simple connected set
    that would break down into x, y and z cartoons.
    The result works out pretty good .

    (* mathematica*)
    Clear[f, g, h, k]
    (* 3d spiral cartoon*)
    r = {{1, 0, 0}, {1/2, 0, 1/4}, {0, 1/2, 1/2}, {1/2, 1,
    3/4}, {1/2, 1.0, 3/4}, {1, 0, 1}}
    ListPointPlot3D[r, PlotStyle -> Red]
    (* x cartoon*)
    f[x_] := r[[1, 1]] /; 0 <= x <= 1/6
    f[x_] := r[[2, 1]] /; 1/6 < x <= 2/6
    f[x_] := r[[3, 1]] /; 2/6 < x <= 3/6
    f[x_] := r[[4, 1]] /; 3/6 < x <= 4/6
    f[x_] := r[[5, 1]] /; 4/6 < x <= 5/6
    f[x_] := r[[6, 1]] /; 5/6 < x <= 1
    ff[x_] = f[Mod[Abs[x], 1]]
    Plot[ff[x], {x, 0, 4}]
    (* y cartoon*)
    g[x_] := r[[1, 2]] /; 0 <= x <= 1/6
    g[x_] := r[[2, 2]] /; 1/6 < x <= 2/6
    g[x_] := r[[3, 2]] /; 2/6 < x <= 3/6
    g[x_] := r[[4, 2]] /; 3/6 < x <= 4/6
    g[x_] := r[[5, 2]] /; 4/6 < x <= 5/6
    g[x_] := r[[6, 2]] /; 5/6 < x <= 1
    gg[x_] = g[Mod[Abs[x], 1]]
    Plot[gg[x], {x, 0, 4}]
    (* z cartoon*)
    h[x_] := r[[1, 3]] /; 0 <= x <= 1/6
    h[x_] := r[[2, 3]] /; 1/6 < x <= 2/6
    h[x_] := r[[3, 3]] /; 2/6 < x <= 3/6
    h[x_] := r[[4, 3]] /; 3/6 < x <= 4/6
    h[x_] := r[[5, 3]] /; 4/6 < x <= 5/6
    h[x_] := r[[6, 3]] /; 5/6 < x <= 1
    hh[x_] = h[Mod[Abs[x], 1]]
    Plot[hh[x], {x, 0, 4}]
    ParametricPlot3D[{ff[x], gg[x], hh[x]}, {x, 0, 1}, PlotStyle -> Red] ParametricPlot3D[{ff[x]*(2 + ff[y]), gg[x]*(2 + gg[y]),
    hh[x]*(2 + hh[y])}, {x, 0, 1}, {y, 0, 1}, ColorFunction -> "Pastel"]
    s0 = N[Log[2]/Log[3]]
    kk[x_] = Sum[ff[3^k*x]/3^(s0*k), {k, 0, 20}];
    Plot[kk[x], {x, 0, 4}]
    ll[x_] = Sum[gg[3^k*(x)]/3^(s0*k), {k, 0, 20}];
    Plot[ll[x], {x, 0, 4}]
    jj[x_] = Sum[hh[3^k*(x)]/3^(s0*k), {k, 0, 20}];
    Plot[jj[x], {x, 0, 4}]
    ParametricPlot[{kk[t], ll[t]}, {t, 0, 1}]
    aa = Table[{kk[n/100000], ll[n/100000]}, {n, 0, 100000}];
    ListPlot[aa, PlotStyle -> {PointSize[0.001], Red}, ImageSize -> 1000]
    cc = Table[{kk[n/100000], jj[n/100000]}, {n, 0, 100000}];
    ListPlot[cc, PlotStyle -> {PointSize[0.001], Red}, ImageSize -> 1000]
    b = Table[{kk[n/100000], ll[n/100000], jj[n/100000]}, {n, 0, 100000}];
    g1 = ListPointPlot3D[b, PlotStyle -> {PointSize[0.001]}, ImageSize -> 1000,
    ColorFunction -> "Rainbow", Background -> Black,
    ViewPoint -> {1, 1, 1}*5];
    g2 = Show[g1, ViewPoint -> Top];
    g3 = Show[g1, ViewPoint -> Front]; Export["6step_spiral_xyztriplecartoon3d4scale.jpg", {g1, g2, g3}]
    (*end*) https://i.pinimg.com/originals/de/4c/b9/de4cb999daeb75f6925c0afaf825116d.jpg

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)