1
$\begingroup$

Disclaimer: I'm not a mathematica expert, I have some programming experience but am still learning how to work mathematica. Also, some of the code from the first block here is not my own, copied/adapted from Wolfram Demonstrations project.

What I am trying to do is generate a table of points. I have a list which I am generating like this:

width = 4;
tuple = Tuples[{0, 1, 2}, width];
pts2 = N[Rescale[
  FromDigits[#, 3] & /@ 
   CellularAutomaton[{1, 3, 1/2}, #, width], {0, 
   3^width - 1}]] & /@ tuple;

Now, what I want to do is have a table which has 3^width entries, each of which is a list of 2d points. For example, here is how I am currently creating the table:

curvPts = Table[{pts2[[i, j]], -j}, {i, 1, 3^width}, {j, 1, width}]

And my first entry in the table, as expected, looks like:

{{0., -1}, {0.5, -2}, {0., -3}, {0.5, -4}}

However, what I am trying to do is get each entry to be something like:

{{0., 0}, {0., -1}, {0.5, -1}, {0.5, -2}, {0, -2}, {0., -3},{0.5, -3}, {0.5, -4},, {0.5, -4}}

Basically for each i in the table, I want there to be 2 j entries, one for j and one for j-1. That way the bezier splines I'm using this to generate will have the curvature I want them to. When I put something like

Table[{{pts2[[i, j]], -j}, {pts2[[i, j]], -(j-1)}}, {i, 1, 3^width}, {j, 1, width}]

The BezierSpline can't read it because the points are nested in pairs.

Any ideas for how to achieve what I'm aiming for?

Thanks

$\endgroup$
0

2 Answers 2

1
$\begingroup$

This seems to me to be a situation where MapIndexed can usefully be applied.

Given pts2 as generated in the question, first get rid of the unwanted last element.

pts = Take[#, width] & /@ pts2;

Then either of the following

tbl = Join @@@ MapIndexed[With[{j = -#2[[2]]}, {{#1, j + 1}, {#1, j}}] &, pts, {2}];

tbl = 
  ReleaseHold @ MapIndexed[With[{j = -#2[[2]]}, Hold[{#1, j + 1}, {#1, j}]] &, pts, {2}];

gives

Short[tbl, 4]
{{{0., 0}, {0., -1}, {0.5, -1}, {0.5, -2}, {0., -2}, {0., -3}, {0.5, -3}, {0.5, -4}}, 
 <<79>>, 
 {{1., 0}, {1., -1}, {0., -1}, {0., -2}, {0.5, -2}, {0.5, -3}, {0., -3}, {0., -4}}}
$\endgroup$
0
$\begingroup$

You can use Join to remove the nesting of pairs:

width = 4;

t = Join @@@ Table[{{pts2[[i, j]], -(j-1)}, {pts2[[i, j]], -(j)}}, 
  {i, 1, 3^width}, {j, 1, width}];

Graphics[{Hue @ RandomReal[], BezierCurve @ #} & /@ t, AspectRatio -> 1]

enter image description here

$\endgroup$

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.