Generating a table with two entries for each i

Question

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

Answer 1

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

Answer 2

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]