# Walking strandbeest dynamics

Posted 2 years ago
6375 Views
|
13 Replies
|
49 Total Likes
|
 Many of you have seen the strandbeest (from Dutch, meaning beach-beast). These PVC tube animals created by Theo Jansen walk along the beach and are wind powered:Years ago (2009 to be more exact) I made a post on my blog about the movement of the legs, as evidenced by the still-nicely-working Mathematica notebook:At the time the proportions of the legs were not known publicly so I meticulously studied frames of (low quality) YouTube videos. I made the following diagram in Illustrator of what I thought I saw: On the left the length of the legs in red, and in blue the numbers of the joints. On the right the trajectory of the joints that I calculated at the time in Mathematica. It's funny that my blog does not exist any more (for years actually), but these images live on, as I found out when I looked for strandbeest on Google Images:My images! But not on my website! Nice to see people still use it. Now, in 2016, I saw these files on my laptop, and thought: is there finally more known about them? Well yes, there is! The exact proportions are now known and there is tons and tons of videos, lectures, 3D-printable strandbeest models, interviews with Theo Jansen and other stuff! So now we can find the exact dimensions readily on the internet: Notice that I (wrongly) assumed that the legs had 'feet'! oops! I was very happy to see that my lengths were not that wrong though! Let's recreate the strandbeest. We do so by first creating a function that quickly finds the intersection of two circles: Clear[FindPoint, FindLines] FindPoint[p1 : {x1_, y1_}, p2 : {x2_, y2_}, R_, r_, side_] := Module[{d, x, y, vc1, vc2, p, sol, sol1, sol2, s1, s2, sr}, d = N@Sqrt[(x2 - x1)^2 + (y2 - y1)^2]; x = (d^2 - r^2 + R^2)/(2 d); y = Sqrt[R^2 - x^2]; vc1 = Normalize[{x2 - x1, y2 - y1}]; vc2 = Cross[vc1]; p = {x1, y1} + x vc1; {sol1, sol2} = {p + y vc2, p - y vc2}; s1 = Sign[Last[Cross[Append[(p2 - p1), 0], Append[(sol1 - p1), 0]]]]; s2 = Sign[Last[Cross[Append[(p2 - p1), 0], Append[(sol2 - p1), 0]]]]; sr = If[side === Left, 1, -1]; Switch[sr, s1, sol1 , s2 , sol2 ] ] This finds on the side 'side' (Left/Right) the intersection point of two circles positioned at p1 and p2, with radii R and r, respectively. And now we can easily compute all the little vertices/joints of our beast: FindLines[\[Theta]_] := Module[{p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15}, {p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15} = FindPoints[\[Theta]]; {{p1, p2}, {p2, p3}, {p3, p4}, {p1, p4}, {p2, p6}, {p4, p6}, {p3, p5}, {p4, p5}, {p5, p8}, {p6, p8}, {p6, p7}, {p7, p8}, {p1, p11}, {p10, p11}, {p2, p10}, {p2, p13}, {p11, p13}, {p10, p12}, {p11, p12}, {p12, p14}, {p13, p14}, {p13, p15}, {p14, p15}} ] FindPoints[\[Theta]_] := Module[{p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16}, p1 = {0, 0}; p4 = {38, -7.8}; p11 = {-38, -7.8}; p2 = 15 {Cos[\[Theta]], Sin[\[Theta]]}; p3 = FindPoint[p2, p4, 50, 41.5, Left]; p6 = FindPoint[p2, p4, 61.9, 39.3, Right]; p5 = FindPoint[p3, p4, 55.8, 41.5, Left]; p8 = FindPoint[p5, p6, 39.4, 36.7, Left]; p7 = FindPoint[p6, p8, 49, 65.7, Right]; p10 = FindPoint[p2, p11, 50, 41.5, Right]; p13 = FindPoint[p2, p11, 61.9, 39.3, Left]; p12 = FindPoint[p10, p11, 55.8, 41.5, Right]; p14 = FindPoint[p12, p13, 39.4, 36.7, Right]; p15 = FindPoint[p13, p14, 49, 65.7, Left]; {p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15} ] Now we can plot it easily: trajectoriesdata = (FindPoints /@ Subdivide[0, 2 Pi, 100])\[Transpose]; Manipulate[ Graphics[{Arrowheads[Large], Arrow /@ trajectoriesdata, Thick, Red, Line[FindLines[\[Theta]]]}, PlotRange -> {{-150, 150}, {-120, 70}}, ImageSize -> 800 ] , {\[Theta], 0, 2 \[Pi]} ] We can also make an entire bunch of legs at the same time and make a 3D beast! Manipulate[ mp = 60; n = 12; \[CurlyPhi] = Table[Mod[5 \[Iota], n, 1], {\[Iota], 1, n}]; Graphics3D[{Darker@Yellow, Table[ Line[ Map[Prepend[mp \[Iota]], FindLines[\[Theta] + \[CurlyPhi][[\[Iota]]] (2 Pi/n)], {2}]], {\[Iota], n} ] , Black, Line[{{mp 1, 0, 0}, {mp n, 0, 0}}] } , Lighting -> "Neutral", PlotRangePadding -> Scaled[.1], PlotRange -> {{-mp, (n + 1) mp}, {-150, 150}, {-150, 150}}, Boxed -> False, ImageSize -> 700 ] , {\[Theta], 0, 2 \[Pi]} ] From the side we can look at how the legs of 4-pair-legged and 6-pair-legged versions of the beasts work: Hope you enjoyed this! Perhaps someone else can make this thing actually walk over a (bumpy) surface?
13 Replies
Sort By:
Posted 2 years ago
 Hi Sander,very nice indeed! I haven't had the opportunity to run any of this yet - I am on my phone, but I wonder whether it would be interesting to look at the gait pattern with some group theory. Ian Stewart has described such an approach here. Thanks for posting!Marco
Posted 2 years ago
 Indeed an interesting idea, let me see what I can do! These diagrams are made for 2 and 4 legs, i have to adapt it two e.g. 12 legs...
Posted 2 years ago
 @Sander Huisman amazing post! I also would like to point to two demonstrations on the subject, see below. @Marco Thiel, indeed an interesting exciting idea about gait pattern. Sander, do you think we really have to adapt to 12, - is due to instability or inefficiency of this strandbeest with 4 legs? Perhaps it could walk with 4?Jansen Walker by Contributed by Karl Scherer, Additional contributions: Theo JansenA Theo Jansen Walking Linkage by Sándor Kabai
Posted 2 years ago
 For 6 pairs of legs (seen in many build-kits), with the phase difference of each successive pairs of legs just being Pi/3, you will get the following animation:where I marked each pair by number and by F(front) and B(back). The trajectory of one of the feet can be obtained like so: pts = Subdivide[0, 2 Pi, 150]; trajectoriesdata = (FindPoints /@ pts)\[Transpose]; trajectoriesdata = trajectoriesdata[[-1]]; Graphics[{Arrow[trajectoriesdata], Point[trajectoriesdata]}, Axes -> True] To get the angles when it touching we find the minima and maxima in X position: ClearAll[XPosFeet,XPosFeet2] XPosFeet[\[Theta]_?NumericQ]:=FindPoints[\[Theta]][[-1,1]] XPosFeet2[\[Theta]_?NumericQ]:=FindPoints[\[Theta]][[7,1]] min\[Theta]=\[Theta]/.Quiet@FindMaximum[XPosFeet[\[Theta]],{\[Theta],2,1,3}][[2]]; max\[Theta]=\[Theta]/.Quiet@FindMinimum[XPosFeet[\[Theta]],{\[Theta],4.5,3,6}][[2]]; {min\[Theta]2,max\[Theta]2}={\[Pi]/2+(\[Pi]/2-min\[Theta]),3\[Pi]/2+(3\[Pi]/2-max\[Theta])} ClearAll[LeftOnGroundQ,RightOnGroundQ] LeftOnGroundQ[\[Theta]_?NumericQ]:=!(min\[Theta]{{min\[Theta],max\[Theta]},{}}] Plot[XPosFeet2[\[Theta]],{\[Theta],0,2\[Pi]},GridLines->{{\[Pi]/2+(\[Pi]/2-min\[Theta]),3\[Pi]/2+(3\[Pi]/2-max\[Theta])},{}}] Manipulate[Graphics[{Red,Line[FindLines[\[Theta]]],If[LeftOnGroundQ[\[Theta]],Disk[{-50,-100}],{}],If[RightOnGroundQ[\[Theta]],Disk[{50,-100}],{}]},PlotRange->{{-150,150},{-120,70}},ImageSize->800],{\[Theta],0,2\[Pi]}] giving:where the dot now indicates touching.Now we can do some bigger code to generate a nice diagram: mp=60; n=6; (*\[CurlyPhi]=Table[Mod[5\[Iota],n,1],{\[Iota],1,n}];*) \[CurlyPhi]=Range[n]; Manipulate[ Graphics3D[{Darker@Yellow,Table[ { Line[ Map[Prepend[mp \[Iota]],FindLines[\[Theta]+\[CurlyPhi][[\[Iota]]] (2Pi/n)],{2}]], {Black,Text[\[Iota],{mp \[Iota],0,50}]} }, {\[Iota],n} ] ,Black,Line[{{mp 1,0,0},{mp n,0,0}}] ,MapThread[Text[#1,{mp (n+1),#2,-100}]&,{{"F","B"},{-50,50}}] } , Lighting->"Neutral", PlotRangePadding->Scaled[.1], PlotRange->{{-mp,(n+1)mp},{-150,150},{-150,150}}, Boxed->False, ImageSize->700 ] , {\[Theta],0,2\[Pi]} ] separators={min\[Theta],max\[Theta],min\[Theta]2,max\[Theta]2}; separators=Table[separators-\[CurlyPhi][[\[Iota]]],{\[Iota],n}]; separators=Mod[Flatten[separators],2\[Pi]]; separators=separators//Prepend[0.0]//Append[2.0\[Pi]]; separators=Union[separators]; regions=Partition[separators,2,1]; expanded=Partition[Subdivide[0,2\[Pi],regions//Length],2,1]; ClearAll[MakeRegionPart] MakeRegionPart[{\[Theta]start_,\[Theta]stop_},{start_,stop_}]:=Module[{eval,onground,ypos,xpos,pos,support}, eval=(\[Theta]start+\[Theta]stop)/2.0; onground=Table[{LeftOnGroundQ[eval+\[CurlyPhi][[\[Iota]]]],RightOnGroundQ[eval+\[CurlyPhi][[\[Iota]]]]},{\[Iota],n}]; xpos=Subdivide[start,stop,3][[2;;-2]]; ypos=Subdivide[0.5,0,n+1][[2;;-2]]; pos=Partition[Reverse/@Tuples[{ypos,xpos}],2]; support=MapThread[If[#1,Disk[#2,0.02],{}]&,{onground,pos},2]; (*Print[support];*) { Line[{{{\[Theta]start,0.75},{\[Theta]start,1.25}},{{\[Theta]stop,0.75},{\[Theta]stop,1.25}}}], Line[{{{start,0},{start,0.5}},{{stop,0},{stop,0.5}}}], {Dashed,Opacity[0.5],Line[{{{\[Theta]start,0.75},{start,0.5}},{{\[Theta]stop,0.75},{stop,0.5}}}]}, support } ] xpos1=Subdivide[Sequence@@expanded[[1]],3][[2;;-2]]; ypos1=Subdivide[0.5,0,n+1][[2;;-2]]; Graphics[{ MapThread[MakeRegionPart,{regions,expanded}], Text[#,{#,1.35}]&/@Range[0,2\[Pi],\[Pi]/2], MapThread[Text[#1,{#2,-0.1}]&,{{"F","B"},xpos1}], MapThread[Text[#1,{-0.1,#2}]&,{Range[n],ypos1}] } ] (* plts=Table[ Plot[{If[LeftOnGroundQ[\[Theta]+\[CurlyPhi][[\[Iota]]]],20-4\[Iota],Missing[]],If[RightOnGroundQ[\[Theta]+\[CurlyPhi][[\[Iota]]]],20-(4\[Iota]+1),Missing[]]},{\[Theta],0,2\[Pi]}] , {\[Iota],n} ]; Show[plts,PlotRange\[Rule]All,GridLines\[Rule]{separators,{}},AspectRatio->1/5,ImageSize\[Rule]1000]*) Giving:I attached my notebook so you can change the number of feet and the relative phases between the legs... Note that this notebook was not meant to be easily understood ;-) Attachments:
Posted 2 years ago
 - another post of yours has been selected for the Staff Picks group, congratulations !We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!
Posted 2 years ago
 Here a bit nicer with small figures:And as an animation:Notebook as attachment. (can now be ran by just executing the entire notebook). Attachments:
Posted 2 years ago
 Hi Sander,thank you very much for sharing this nice code - I already had a lot of fun playing around with it! I have just a little remark to make: It seems to me that in your function FindPoints there is a typo; it should read (see comments, c.f. line "d"): FindPoints[\[Theta]_] := Module[{p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12, p13, p14, p15, p16}, p1 = {0, 0}; p4 = {38, -7.8}; p11 = {-38, -7.8}; p2 = 15 {Cos[\[Theta]], Sin[\[Theta]]}; p3 = FindPoint[p2, p4, 50, 41.5, Left]; p6 = FindPoint[p2, p4, 61.9, 39.3, Right]; p5 = FindPoint[p3, p4, 55.8, 40.1(*41.5*), Left]; p8 = FindPoint[p5, p6, 39.4, 36.7, Left]; p7 = FindPoint[p6, p8, 49, 65.7, Right]; p10 = FindPoint[p2, p11, 50, 41.5, Right]; p13 = FindPoint[p2, p11, 61.9, 39.3, Left]; p12 = FindPoint[p10, p11, 55.8, 40.1(*41.5*), Right]; p14 = FindPoint[p12, p13, 39.4, 36.7, Right]; p15 = FindPoint[p13, p14, 49, 65.7, Left]; {p1, p2, p3, p4, p5, p6, p7, p8, p10, p11, p12, p13, p14, p15}] Then the resulting trajectory of the foot motion (along the ground) looks better:Best regards -- Henrik
Posted 2 years ago
 oops! one length is wrong! Well, easy to correct ;) Thanks for spotting!
Posted 2 years ago
 In the spirit of the original T. Jensen art I think it is a good idea to use XKCD styling of the graphics:Here is the code (using modifications of Mr.Wizard's answer at MSE): (*********************************) (* Mr.Wizard's code for XKCD style*) (*********************************) split[{a_, b_}] := If[a == b, {b}, With[{n = Ceiling[3 Norm[a - b]]}, Array[{n - #, #}/n &, n].{a, b}]] partition[{x_, y__}] := Partition[{x, x, y}, 2, 1] nudge[L : {a_, b_}, d_] := Mean@L + d Cross[a - b]; gap = {style__, x_BSplineCurve} :> {{White, AbsoluteThickness[10], x}, style, AbsoluteThickness[2], x}; wiggle[pts : {{_, _} ..}, d_: {-0.15, 0.15}] := ## &[#~nudge~RandomReal@d, #[[2]]] & /@ partition[Join @@ split /@ partition@pts] xkcdify[plot_Graphics] := Show[FullGraphics@plot, TextStyle -> {17, FontFamily -> "Humor Sans"}] /. Line[pts_] :> {AbsoluteThickness[2], BSplineCurve@wiggle@pts} // MapAt[# /. gap &, #, {1, 1}] & (* Modification *) xkcdify[plot : (Line | Arrow)[_], d_: {-0.15, 0.15}] := Block[{funcHead = Head[plot], bf = BSplineCurve}, If[funcHead === Arrow, bf = Arrow@*bf]; plot /. funcHead[pts_] :> {AbsoluteThickness[2], bf@(wiggle[#, d] &)@pts} // MapAt[# /. gap &, #, {1, 1}] & ]; (******************************) (* Sander's code modification *) (******************************) rescaleRule = {x_?NumericQ, y_?NumericQ} :> {Rescale[x, {-150, 150}, {-3, 3}], Rescale[y, {-120, 50}, {-2.5, 1}]}; FindLines[0.4] /. rescaleRule; trajectoriesdata = (FindPoints /@ Subdivide[0, 2 Pi, 100])\[Transpose]; trajectoriesdataXKCD = Map[xkcdify[Arrow[#], {-0.23, 0.23}] &, (trajectoriesdata /. rescaleRule)]; man = Manipulate[ Graphics[{Arrowheads[Large], trajectoriesdataXKCD, Thick, Red, Map[xkcdify[Line[#], {-0.1, 0.1}] &, FindLines[\[Theta]] /. rescaleRule]}, Frame -> True, PlotRange -> {{-3, 3}, {-3, 1}}, ImageSize -> 800], {\[Theta], 0, 2 \[Pi]}, AutorunSequencing -> {Automatic, 5}] 
Posted 2 years ago
 Haha nice combination! thanks for sharing!
Posted 2 years ago