Function Repository Resource:

BandWeaver

Turn polylines into woven bands

Contributed by: Ed Pegg Jr

ResourceFunction["BandWeaver"][polylines,halfwidth]

returns polygon bands of twice a given halfwidth for an over/under weaving of self-intersecting polylines.

Details

In knot theory, the Gauss notation of a closed loop assigns a number to all intersections. Following the loop, an over-crossing is read as positive and an undercrossing as negative. Although non-alternating knots exist, it's always possible to present a closed loop in an alternating form.

Based on the Celtic weaving code from the Book of Kells.

Examples

Basic Examples (2)

Turn a polyline into woven bands:

In[1]:=

Out[2]=

Look at the polyline and the generated polygon bands:

In[3]:=

Out[3]=

Look at the full woven band:

In[4]:=

Out[4]=

Show knight moves:

In[5]:=

Out[5]=

Scope (2)

Results of BandWeaver can be combined with other graphics:

In[6]:=

polyline = {{0, 0}, {2, 1}, {1, 0}, {0, 1}, {2, 0}, {1, 1}};
part = Partition[polyline, 2, 1, 1];
Graphics[{EdgeForm[{Gray, Thin}], Yellow, ResourceFunction["BandWeaver"][polyline, .05],
Blue, Table[Text[k, (3 part[[k, 1]] + 2 part[[k, 2]])/5], {k, 1, 6}]}]

Out[8]=

BandWeaver works for multiple polylines:

In[9]:=

lines = 3 N[CirclePoints[9]][[#]] & /@ Transpose[Partition[Range[9], 3]];
bands = ResourceFunction["BandWeaver"][lines, .1];
Graphics[{EdgeForm[{Black, Thick}], Cyan, bands[[1]], Green, bands[[2]],
Blue, bands[[3]]}]

Out[11]=

Applications (3)

Code for a bouncing ball:

In[12]:=

$BouncePolyline45[w_, h_, p0_, dir_ : {1, 1}] := Module[{x = p0[[1]], y = p0[[2]], vx, vy, t = 0, T, pts, dx, dy, dt}, {vx, vy} = Sign[dir] /. 0 -> 1; T = LCM[2 w, 2 h];(*for integer w,h;4\[Times]7\[RightArrow]56*) pts = {{x, y}}; While[t < T, dx = If[vx > 0, w - x, x]; dy = If[vy > 0, h - y, y]; dt = Min[dx, dy, T - t]; x = x + vx dt; y = y + vy dt; t = t + dt; pts = Append[pts, {x, y}]; If[dt === dx, vx = -vx]; If[dt === dy, vy = -vy];]; pts] pts = BouncePolyline45[14, 8, {3, 0}, {1, 1}]$

Out[13]=

Let's make a Celtic weave out of it:

In[14]:=

Out[14]=

Let's try weaving some weaving:

In[15]:=

pts = {{-.5, -.5}, {5, 5}, {8, 2}, {6, 0}, {1, 5}, {0, 4}, {4, 0}, {8,
4}, {7, 5}, {2, 0}, {0, 2}, {3, 5}, {8.5, -.5}};
bands = ResourceFunction[
"BandWeaver"][{pts, # {1, -1} + {2, 5} & /@ pts}, .18];
Graphics[{EdgeForm[{Black}], Green, bands[[1]], Cyan, bands[[2]]}]

Out[17]=

Whoops, got the wrong offset. Let's change a digit to shove that over:

In[18]:=

Out[19]=

Show a knight's tour:

In[20]:=

grid86 = Tuples[{Range[8], Range[6]}]; knighttour = grid86[[{1, 9, 5, 18, 29, 42, 46, 33, 41, 30, 17, 6, 10, 23, 12, 4, 15, 2, 13, 21, 25, 38, 27, 35, 48, 40, 44, 31, 20, 7, 3, 16, 8, 19,
32, 43, 39, 26, 37, 45, 34, 47, 36, 28, 24, 11, 22, 14}]];
Graphics[{EdgeForm[{Thin, Gray}], White, Rectangle /@ (grid86 - 1/2), EdgeForm[{Black, Thick}], Green, ResourceFunction["BandWeaver"][knighttour, .05]}]

Out[21]=

Possible Issues (2)

The possible band thickness is limited, most of the time:

In[22]:=

Out[22]=

If the band is too wide, the code will fail in various ways:

In[23]:=

Out[23]=

Without self-intersection, the ResourceFunction PerforatePolygons is needed instead:

In[24]:=

Out[24]=

A single self-intersection is enough:

In[25]:=

Out[25]=

Neat Examples (2)

Code for making star polylines:

In[26]:=

$StarPolyline[n_Integer?Positive, k_Integer] := CirclePoints[n][[#]] & /@ Table[NestList[Mod[# - 1 + Mod[k, n], n] + 1 &, s, n/GCD[n, Mod[k, n]] - 1], {s, 1, GCD[n, Mod[k, n]]}];$