Message Boards

GROUPS:

Visual Arts Graphs and Networks Wolfram Language Modeling Wolfram High School Summer Camp

4

[WSC21] Computational Crochet

Eliza Morton

Posted 17 days ago

298 Views

|

1 Reply

|

4 Total Likes

Follow this post

|

The objective of this project was to compute simple and complex surfaces through crochet. I began by establishing a formula for simple polygons, creating a system that could construct any trapezoid or triangle. Said trapezoids and triangles can be stacked on top of each other to make a pattern for any polygon. I then looked into creating patterns for curved structures, and made a function that can semi-successfully make a crochet pattern given an equation. Basics of Crochet Crochet is a fiber art that uses yarn and a hook to create textiles. The “atom” of crochet is a chain, made by pulling loops of yarn through a hole in the previous row: Increases and decreases in the number of chains per row are made by creating two chains in one chain in the previous row or skipping one chain in the previous row, respectively. Each chain is directly connected to a specific chain in the row below it, as well as it’s adjacent neighbors. For Wolfram Summer Camp my project leveraged on how crochet patterns can be represented as a grid-like graph: Simple Polygons To define trapezoids, I will be using height, left base, right base, left roof, and right roof, as seen below: For these purposes, triangles are effectively trapezoids with roofs of 1. Row Lengths The first step to making a crochet pattern is deciding how many chains in each row. I made a function "widths" to take the chain count of the height, left base, right base, left roof, and right roof, and find the width of the project at each row using simple algebra. Using vertices to represent chains and edges to represent connections, it outputs the columns in which each row has a chain: In[]:= widths[height_Integer,leftbase_,rightbase_,leftroof_,rightroof_]:=DeleteCases[ Table[ Flatten[ Sort[Table[leftbase-a+1,{a,Round[(leftbase-leftroof)(1-x/height)]+leftroof}]], Table[a+leftbase,{a,Round[(rightbase-rightroof)(1-x/height)]+rightroof}] , 1], {x,1,height,1}],{}] In[]:= widths[6,1,3,3,1] Out[]= {{1,2,3,4},{1,2,3,4},{0,1,2,3},{2,3,4,5},{-1,0,1,2},{3,4,5,6}} Unfortunately, crochet works with a snake-like pattern, alternating the direction of the row. This output would not allow me to easily make directed edges that actually follow the correct order. Instead, I split the function into odd rows and even rows, with even rows' doing the exact opposite of the odds', and riffled the two together. In[]:= widths[height_Integer,leftbase_,rightbase_,leftroof_,rightroof_]:=DeleteCases[ Riffle[ (Odd) Table[Flatten[ Sort[Table[leftbase-a+1,{a,Round[(leftbase-leftroof)(1-x/height)]+leftroof}]], Table[a+leftbase,{a,Round[(rightbase-rightroof)(1-x/height)]+rightroof}] , 1], {x,1,height,2}], (Even) Table[Flatten[ Sort[Table[rightbase-a+1,{a,Round[(rightbase-rightroof)(1-x/height)]+rightroof}]], Table[a+rightbase,{a,Round[(leftbase-leftroof)(1-x/height)]+leftroof}] , 1], {x,1,Floor[height/2]2,2}] ],{}] In[]:= widths[6,1,3,3,1] Out[]= {{1,2,3,4},{1,2,3,4},{0,1,2,3},{2,3,4,5},{-1,0,1,2},{3,4,5,6}} This output has the number of the columns switching every row, which makes it more difficult for a human to read, but it allows the computer to arrange it correctly later on. Edges Now that I had the row's components, I began to connect them. I started with the first row, which has unique instructions due to being the baseline. I connected each vertex—labeled by {row, column}—to the next with a directed edge, all the way up to the second-to-last vertex. w=widths[height,leftbase,rightbase,leftroof,rightroof];Table[{1,a}{1,a+1},{a,First[w[[1]]],Last[w[[1]]]-1}]; The last vertex in that row doesn't go to another adjacent vertex; it connects up to the first vertex of the second row. This ease is due the the riffling in the widths function: the last of each row lines up with the first of the next. {1,Last[w[[1]]]}{2,First[w[[2]]]} After this is a section of code for all but the first row. It is split into two pieces: one for all but the last column, and one for all columns. The one for all but the last column connects each vertex to its adjacent vertex, and connects it to the vertex in the previous row directly below it. If that vertex does not exist, it connects to the closest vertex in the previous row. In[]:= helperDetectionRows[w_,b_,a_]:=If[ContainsAll[w[[b-1]],{Length[w[[1]]]+1-a}],Length[w[[1]]]+1-a,Nearest[w[[b-1]],Length[w[[1]]]+1-a][[1]]] In[]:= Table[ (adjacent) {b,a}{b,a+1}, (row below) {b,a}{b-1, helperDetectionRows[w,b,a]} , {b,2,Length[w]}, {a,First[w[[b]]],Last[w[[b]]]-1}] Out[]= {{{{2,1}{2,2},{2,1}{1,6}},{{2,2}{2,3},{2,2}{1,5}},{{2,3}{2,4},{2,3}{1,4}},{{2,4}{2,5},{2,4}{1,3}},{{2,5}{2,6},{2,5}{1,2}}},{{{3,2}{3,3},{3,2}{2,5}},{{3,3}{3,4},{3,3}{2,4}},{{3,4}{3,5},{3,4}{2,3}}},{{{4,2}{4,3},{4,2}{3,5}},{{4,3}{4,4},{4,3}{3,4}},{{4,4}{4,5},{4,4}{3,3}}},{{{5,3}{5,4},{5,3}{4,4}}}} In the piece for all columns, I connected each final vertex to the corresponding vertex in the previous row, using the same rule in said vertex's absence. In[]:= helperDetectionColumns[w_,b_]:=If[ContainsAll[w[[b-1]],{Length[w[[1]]]+1-Last[w[[b]]]}],Length[w[[1]]]+1-Last[w[[b]]],Nearest[w[[b-1]],Length[w[[1]]]+1-Last[w[[b]]]][[1]]] In[]:= Table[ {b,Last[w[[b]]]}{b-1, helperDetectionColumns[w,b]} , {b,2,Length[w]}] Out[]= {{{2,6}{1,1}},{{3,5}{2,2}},{{4,5}{3,2}},{{5,4}{4,3}}} Now, outside of this Table for all rows but first, I connected the final vertex of all the non-first-nor-last rows to the first vertex of the next row. In[]:= Table[ {b,Last[w[[b]]]}{b+1,First[w[[b+1]]]} , {b,2,Length[w]-1}] Out[]= {{{2,6}{3,2}},{{3,5}{4,2}},{{4,5}{5,3}}} All together, we have the function: In[]:= edges[height_Integer,leftbase_,rightbase_,leftroof_,rightroof_]:= w=widths[height,leftbase,rightbase,leftroof,rightroof]; , Flatten[ (first row (base)) Table[{1,a}{1,a+1}, {a,First[w[[1]]],Last[w[[1]]]-1}], (connect last 1st to first 2nd) {1,leftbase+rightbase}{2,First[w[[2]]]}, (later rows) Table[ Table[ (adjacent) {b,a}{b,a+1}, (row below) {b,a}{b-1,helperDetectionRows[w,b,a]} , {a,First[w[[b]]],Last[w[[b]]]-1} ], (last vertex in row)(below) {b,Last[w[[b]]]}{b-1,helperDetectionColumns[w,b]} , {b,2,Length[w]} ], (All but first and last row - connect to next row) Table[ {b,Last[w[[b]]]}{b+1,First[w[[b+1]]]} , {b,2,Length[w]-1} ] ][[2]] Now, with our edges function, we can graph the final pattern: In[]:= Graph[edges[6,1,3,3,1],VertexLabelsAutomatic] Out[]= Connecting Trapezoids Now that we have a function that creates patterns for trapezoids, we can stack them on top of each other to create more complicated polygons. To do this, I added parameters to"widths" and "edges" that allow for an offset in both the x and y direction in order to make the first trapezoid's last row the same as the next trapezoid's first row. In[]:= widths[height_Integer,leftbase_,rightbase_,leftroof_,rightroof_,xoffset_]:=DeleteCases[Riffle[ (Odd) Table[ Flatten[ Sort[Table[leftbase-a+1+xoffset, {a,Round[(leftbase-leftroof)(1-x/height)]+leftroof}]], Table[a+leftbase+xoffset,{a,Round[(rightbase-rightroof)(1-x/height)]+rightroof}] , 1], {x,1,height,2} ], (Even) Table[ Flatten[ Sort[Table[rightbase-a+1-xoffset,{a,Round[(rightbase-rightroof)(1-x/height)]+rightroof}]], Table[a+rightbase-xoffset,{a,Round[(leftbase-leftroof)(1-x/height)]+leftroof}] , 1], {x,1,Floor[height/2]2,2} ]],{}];edges[height_Integer,leftbase_,rightbase_,leftroof_,rightroof_,xoffset_:0,yoffset_:0]:= w=widths[height,leftbase,rightbase,leftroof,rightroof,xoffset]; , Flatten[ (first row (base)) Table[{1+yoffset,a}{1+yoffset,a+1}, {a,First[w[[1]]],Last[w[[1]]]-1}], (connect last 1st to first 2nd) {1+yoffset,leftbase+rightbase+xoffset}{2+yoffset,First[w[[2]]]}, (later rows) Table[ Table[ (adjacent) {b+yoffset,a}{b+yoffset,a+1}, (row below) {b+yoffset,a}{b+yoffset-1, helperDetectionRows[w,b,a]} , {a,First[w[[b]]],Last[w[[b]]]-1} ], (last vertex in row)(below) {b+yoffset,Last[w[[b]]]}{b+yoffset-1, helperDetectionColumns[w,b]} , {b,2,Length[w]} ], (All but first and last row - connect to next row) Table[{{b+yoffset,Last[w[[b]]]}{b+yoffset+1,First[w[[b+1]]]}}, {b,2,Length[w]-1}] ][[2]] Using this new functionality, we can combine two "edges" outputs to make one graph In[]:= Graph[Union[edges[6,1,3,3,1],edges[7,3,1,4,5,2,5]],VertexLabelsAutomatic] Out[]= I followed this pattern exactly to crochet this: I also created formulas for simple pentagons and hexagons, whose logic can be applied for more polygons: In[]:= pentagon[left1_,right1_,height1_,left2_,right2_,height2_]:=Graph[ Union[ edges[height1,left1,right1,left2,right2], edges[height2,left2,right2,1,1,left1-left2,height1-1] ], VertexLabelsAutomatic]hexagon[left1_,right1_,height1_,left2_,right2_,height2_,left3_,right3_]:=Graph[ Union[ edges[height1,left1,right1,left2,right2], edges[height2,left2,right2,left3,right3,left1-left2,height1-1] ], VertexLabelsAutomatic] Application To apply my function to 3D structures, I decomposed a triangular prism into its faces: three rectangles and two triangles. I decided on equilateral triangles with side length 6 and rectangles of height 12. In[]:= Row[ Flatten[  Graph[#[[1]],VertexLabels->Automatic], #[[2]] &/@{{edges[6,6,6,6,6],"3 Rectangles"},{edges[Round[3Sqrt[3]],3,3,1,1],"2 Triangles"}} ]] Out[]= 3 Rectangles 2 Triangles Following these instructions and WL's net for a triangular prism, I created this: It worked very accurately for such a small number of chains; chains only work in whole numbers, which doesn't allow for precise slopes. Curved Surfaces Because my previous method relied on an assumption of flat surfaces, I was unsure of how to approach curved surfaces. One problem is that crochet isn't an exact science: yarn can be squished and stretched enough that one can't rely on it to hold its shape; on the other hand, it doesn't follow the malleability rules of topology. Everything must be approximated. Establishing a base set of vertices I figured a good place to start would be establishing a list of vertices at every whole number {x,y} of a 3D function. In[]:= points=Table[Table[{x,y,x^2+2 y^2+3 x^3+4 y^4+5 x^5+6 y^6},{y,-1,1,.2}],{x,-1,1,.2}]; I then followed my old method for rows: adding directed edges along adjacent vertices. However, this time it was not as simple. Each connection has a length of 1 unit, and with a curved surface I couldn't simply assume that the distance from {x,y} to {x+1,y+1} would be 1 unit. Instead, for each vertex, I rounded the distance from it to the next vertex and added more vertices as necessary to have ~1 unit in between vertices. To keep track of which points were at which coordinates, I set up the table to be formatted {{{coordinates, {row,column}}, [directed edge to next point]} In[]:= Table[  points[[y]][[x]]+a(points[[y]][[x+1]]-points[[y]][[x]]), (coordinates) {y,x+a},(row and column) {y,x+a}{y,x+a+1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1]}(connection) , {a,0,1-1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1],1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1]}] Mapping that function across all rows gives us: In[]:= rows=Table[ Flatten[ Table[ Table[  points[[y]][[x]]+a(points[[y]][[x+1]]-points[[y]][[x]]), (coordinates) {y,x+a} (row and column) , {y,x+a}{y,x+a+1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1]} , {a,0,1-1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].2],1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1]} ], {x,1,Length[points[[y]]]-1,1} ], 2], {y,1,Length[points],1}]; I then made lists with information extracted from "rows": the edges listed in rows ("edgesrows"), each coordinate along with its row and column ("associationlist"), a list of all coordinates used ("coordinatelist"), and a list of all points ("pointlist"). In[]:= edgesrows=Flatten[Table[Table[rows[[a]][[n]],{n,2,Length[rows[[a]]],2}],{a,1,Length[rows]}]];associationlist=Flatten[Table[Table[rows[[a]][[x]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}],1];coordinatelist=Table[Table[rows[[a]][[x]][[1]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}];pointlist=Table[Table[rows[[a]][[x]][[2]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}]; Next is an association between the coordinates and their row and column. Using that, I made a function that for each vertex in rows after 1, there is an undirected edge between it and the nearest (in coordinates) vertex in the row below. In[]:= vertassoc=Association[#[[1]]#[[2]]&/@associationlist];vertedges=Flatten[Table[Table[vertassoc[coordinatelist[[a]][[x]]]vertassoc[Nearest[coordinatelist[[a-1]],coordinatelist[[a]][[x]]][[1]]],{x,1,Length[coordinatelist[[a]]]}],{a,2,Length[coordinatelist]}]]; The final set of edges connects each last edge in a row to the last in the row above In[]:= lastinrow=Table[Last[Sort[pointlist[[x]]]]Last[Sort[pointlist[[x+1]]]], {x,1,Length[pointlist]-1}]; Now, we can plug all our edges into a Graph3D: In[]:= Graph3D[Union[edgesrows,vertedges,lastinrow],VertexLabelsAutomatic] Out[]= Putting these altogether, we have a function that takes an equation, x and y boundaries, and baseline vertex distance, and outputs a graph pattern. In[]:= curvedgraph[equation_,xbounds_,ybounds_,initspacing_]:=Last[  points=Table[Table[equation,{y,ybounds[[1]],ybounds[[2]],initspacing}],{x,xbounds[[1]],xbounds[[2]],initspacing}]; rows=Table[Flatten[ Table[ Table[  points[[y]][[x]]+a(points[[y]][[x+1]]-points[[y]][[x]]),(coordinates) {y,x+a}(row and column) , {y,x+a}{y,x+a+1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].1]}(connection) , {a,0,1-1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]].2],1/Ceiling[EuclideanDistance[points[[y]][[x]],points[[y]][[x+1]]]*.1]} ], {x,1,Length[points[[y]]]-1,1} ], 2], {y,1,Length[points],1} ]; edgesrows=Flatten[Table[Table[rows[[a]][[n]],{n,2,Length[rows[[a]]],2}],{a,1,Length[rows]}]]; associationlist=Flatten[Table[Table[rows[[a]][[x]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}],1]; vertassoc=Association[#[[1]]#[[2]]&/@associationlist]; coordinatelist=Table[Table[rows[[a]][[x]][[1]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}]; pointlist=Table[Table[rows[[a]][[x]][[2]],{x,1,Length[rows[[a]]]-1,2}],{a,1,Length[rows]}]; vertedges=Flatten[ Table[ Table[ vertassoc[coordinatelist[[a]][[x]]]vertassoc[Nearest[coordinatelist[[a-1]],coordinatelist[[a]][[x]]][[1]]], {x,1,Length[coordinatelist[[a]]]} ], {a,2,Length[coordinatelist]} ] ]; lastinrow=Table[Last[Sort[pointlist[[x]]]]Last[Sort[pointlist[[x+1]]]],{x,1,Length[pointlist]-1}]; Graph3D[Union[edgesrows,vertedges,lastinrow],VertexLabelsAutomatic] ] In[]:= curvedgraph[{x,y,x^2+2 y^2+3 x^3+4 y^4+5 x^5+6 y^6},{-1,1},{-1,1},.2] Out[]=