9
\$\begingroup\$

The code that I am doing is to simulate a scenario where a mechanical arm search pieces closer and these pieces selected the mechanical arm leaves in a position defined closer.

Clear["Global`*"] BezierCircleArc[{x_,y_},r_,{θ1_,θ2_}]:= Module[{α,p0,p1,p2,p3}, α=4/3Tan[(θ2-θ1)/4]; p0={x,y}+r{Cos[θ1],Sin[θ1]}; p3={x,y}+r{Cos[θ2],Sin[θ2]}; p1=p0+α r{-Sin[θ1],Cos[θ1]}; p2=p3+α r{Sin[θ2],-Cos[θ2]};BezierCurve[{p0,p1,p2,p3}]]

Initial position

pInitial={106.8,0};

Arm

lenghtInitialArm=90; arm={ BezierCircleArc[{lenghtInitialArm+16.8,0},20,{2.57,3.72}], Line[{{0,12.5},{lenghtInitialArm,12.5},{lenghtInitialArm,12.5},{lenghtInitialArm,10.87}}], Line[{{0,-12.5},{lenghtInitialArm,-12.5},{lenghtInitialArm,-12.5},{lenghtInitialArm,-10.87}}], {EdgeForm[Black],GrayLevel[0.84],Disk[armCenter={0,0},18]}, {EdgeForm[Black],GrayLevel[0.50],Disk[armCenter={0,0},6]}};

Claws

claws={EdgeForm[Black], GrayLevel[.84], FilledCurve[{ BezierCircleArc[{lenghtInitialArm+16.8,0},rClaws=20,claw1a={0.8,2.9}], BezierCircleArc[{lenghtInitialArm-5,5.6},2.5,claw1b={6.03-2π,2.9-2π}][[;;,2;;]], BezierCircleArc[{lenghtInitialArm+16.8,0},25,Reverse@claw1a-2π][[;;,2;;]], BezierCircleArc[{lenghtInitialArm+32.54,16.07},2.5,claw1c={0.8,-2.35}][[;;,2;;]]}]};

Arm + Claws

robot={GeometricTransformation[{arm,u=GeometricTransformation[claws, {RotationTransform[0Degree,{85,5.6}]}], GeometricTransformation[u,ReflectionTransform[{0,1},{85,0}]]}, RotationTransform[initialPosition=0Degree,{0,0}]]};

Box

espBox=6;recX1=160;recY1=-80;recX2=recX1+6rClaws+4espBox;recY2=-30; posPieces={{150,105},{32,220},{320,175}}; posPiecesFinal={ {recX1+espBox+rClaws,(recY1 + recY2)/2}, {recX1+3 rClaws+espBox+5,(recY1 + recY2)/2}, {recX1+5 rClaws+espBox+10,(recY1 + recY2)/2}}; boxGoal={EdgeForm[{Thickness[0.005],Black}],White,Rectangle[{recX1,recY1},{recX2,recY2}]}; pieces={EdgeForm[Black],RGBColor[0.35,0.30,0.25],Disk[posPieces[[1]],20],Disk[posPieces[[2]],20],Disk[posPieces[[3]],20]}; piecesFinal={Dashed,EdgeForm[Red],White,Disk[posPiecesFinal[[1]],20],Disk[posPiecesFinal[[2]],20],Disk[posPiecesFinal[[3]],20]};

The function below determines the shortest route that the arm mechanism must follow to perform this procedure.

Route Logic

f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPieces, pInitial]] // N; p1 = posPieces[[First[sol]]]; posPieces = Drop[posPieces, {First[sol]}]; f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPiecesFinal, p1]] // N; p2 = posPiecesFinal[[First[sol]]]; posPiecesFinal = Drop[posPiecesFinal, {First[sol]}]; f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPieces, p2]] // N; p3 = posPieces[[First[sol]]]; posPieces = Drop[posPieces, {First[sol]}]; f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPiecesFinal, p3]] // N; p4 = posPiecesFinal[[First[sol]]]; posPiecesFinal = Drop[posPiecesFinal, {First[sol]}]; f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPieces, p4]] // N; p5 = posPieces[[First[sol]]]; posPieces = Drop[posPieces, {First[sol]}]; f[pG_, pI_] := {pos = Position[ EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]], Min[EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]]], Extract[(EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]), First@pos]}; sol = Flatten[f[posPiecesFinal, p5]] // N; p6 = posPiecesFinal[[First[sol]]]; posPiecesFinal = Drop[posPiecesFinal, {First[sol]}]; positions = {pInitial, p1, p2, p3, p4, p5, p6}; This graphic serves basically to illustrate the route to be covered gArrow = {Red, Arrowheads[0.05], Thickness[0.008], Arrow[positions]}; Graphics[{boxGoal, pieces, robot, piecesFinal, gArrow}, Axes -> True, ImageSize -> 500, Background -> White];

With the function below I determine the angles needed to perform the route

angList[p_] := (p - armCenter) angList = ArcTan @@ angList[#] & /@ positions/Degree // N; numberTotalFrames = 300; framesClaws = 4; numberFramesStopped = framesClaws*(Length[angList] - 1); framesStoppedAng = Transpose[Table[Rest@angList, framesClaws]]; restFrames = numberTotalFrames - numberFramesStopped; diffAng = Differences[angList]; accDiffAng = Accumulate@Abs@diffAng; sumAllAng = Last@accDiffAng; quantRestFrames = Round[N[Abs@diffAng[[#]]/Last@accDiffAng]*restFrames] & /@ Range[Length[accDiffAng]]; subListsAng = Map[Most, Subdivide @@@ Transpose@{Most@angList, Rest@angList, quantRestFrames}]; angListAnim = Flatten[Riffle[subListsAng, framesStoppedAng]]; ListLinePlot[angListAnim, PlotTheme -> "Monochrome", ImageSize -> {1200, 800}, AxesLabel -> {HoldForm[Frames], HoldForm[Angles]}, PlotLabel -> HoldForm[Angles x Frames], LabelStyle -> {FontFamily -> "Arial", 12, GrayLevel[0]}]

With the function below I determine the lenghts needed to perform the route

plenghtArm = EuclideanDistance[ positions[[#]], {0, 0}] - (106.8 - (lenghtInitialArm = 90)) & /@ Range[Length[positions]] // N; quantFramesLenghtArm = quantRestFrames; subListsLenghtArm = Map[Most, Subdivide @@@ Transpose@{Most@plenghtArm, Rest@plenghtArm, quantFramesLenghtArm}]; framesStoppedLenghtArm = Transpose[Table[Rest@plenghtArm, framesClaws]]; plenghtArmAnim = Flatten[Riffle[subListsLenghtArm, framesStoppedLenghtArm]]; ListLinePlot[plenghtArmAnim, PlotTheme -> "Monochrome", ImageSize -> {1200, 800}, AxesLabel -> {HoldForm[Frames], HoldForm[Length]}, PlotLabel -> HoldForm[Length x Frames], LabelStyle -> {FontFamily -> "Arial", 12, GrayLevel[0]}]

Here I present my solution for the arm mechanic collection the pieces and can put this pieces in place appropriate

Flatten @@ Table[Graphics[{boxGoal, pieces, piecesFinal, {GeometricTransformation[{{BezierCircleArc[{plenghtArmAnim[[#]] + 16.8, 0}, 20, {2.57, 3.72}], Line[{{0, 12.5}, {plenghtArmAnim[[#]], 12.5}, {plenghtArmAnim[[#]], 12.5}, {plenghtArmAnim[[#]], 10.87}}], Line[{{0, -12.5}, {plenghtArmAnim[[#]], -12.5}, {plenghtArmAnim[[#]], -12.5}, {plenghtArmAnim[[#]], -10.87}}], {EdgeForm[Black], GrayLevel[0.84], Disk[armCenter = {0, 0}, 18]}, {EdgeForm[Black], GrayLevel[0.50], Disk[armCenter = {0, 0}, 6]}}, u = GeometricTransformation[{EdgeForm[Black], GrayLevel[0.84], FilledCurve[{BezierCircleArc[{plenghtArmAnim[[#]] + 16.8, 0}, rClaws = 20, claw1a = {0.8, 2.9}], BezierCircleArc[{plenghtArmAnim[[#]] - 5, 5.6}, 2.5, claw1b = {6.03 - 2*Pi, 2.9 - 2*Pi}][[1 ;; All, 2 ;; All]], BezierCircleArc[{plenghtArmAnim[[#]] + 16.8, 0}, 25, Reverse[claw1a] - 2*Pi][[1 ;; All, 2 ;; All]], BezierCircleArc[{plenghtArmAnim[[#]] + 32.54, 16.07}, 2.5, claw1c = {0.8, -2.35}][[1 ;; All, 2 ;; All]]}]}, {RotationTransform[ 0 Degree, {85, 5.6}]}], GeometricTransformation[u, ReflectionTransform[{0, 1}, {85, 0}]]}, RotationTransform[ initialPosition = angListAnim[[#]] Degree, {0, 0}]]}}, Axes -> True, ImageSize -> 500, Background -> White, PlotRange -> {{400, -40}, {-90, 250}}], 1] & /@ Range[300];

The question would be as follows:

Could someone propose some improvement to shorten this code?

\$\endgroup\$

    1 Answer 1

    Reset to default
    2
    \$\begingroup\$

    1. Encapsulate your “nearest-neighbor” logic

    You repeat the same block of code six times:

    f[pG_, pI_] := Module[{dists, i}, dists = Norm[ pG[[#]] - pI ] & /@ Range[Length[pG]]; i = First@Ordering[dists, 1]; {i, dists[[i]]} ]; {idx, dist} = f[posList, posCurrent]; selectedPoint = posList[[idx]]; posList = Delete[posList, idx];

    Instead, write a single pure function:

    nearestStep[{pts_List, p_}] := Module[{i}, i = First@Ordering[Norm[ # - p ] & /@ pts, 1]; { pts[[i]], Delete[pts, i] } ];

    Then you can build your entire route in one go:

    (* initial data *) boxes = posPieces; places = posPiecesFinal; current = pInitial; (* alternate between picking from boxes and places *) routeAndRest = NestList[ If[ EvenQ@#2, nearestStep[{boxes, #1}], nearestStep[{places, #1}]]&, current, 6 ]; (* routeAndRest is a list of {{pickedPoint, remainingList}, …} *) positions = Prepend[ First /@ routeAndRest, pInitial ];

    Or if you really just want positions:

    positions = FoldList[ Function[{p, pts}, First@nearestStep[{pts, p}]], pInitial, {posPieces, posPiecesFinal, posPieces, posPiecesFinal, posPieces, posPiecesFinal} ];

    2. Vectorize your distance calls

    Instead of

    EuclideanDistance[pI, Evaluate@pG[[#]]] & /@ Range[Length[pG]]

    use

    Norm /@ (pG - pI)

    or even better

    dists = Norm /@ (pG - pI) (* or *) dists = Chop@Sqrt@Total[(pG - pI)^2, {2}];

    3. Compute angles & lengths in one pass

    Rather than computing

    1. angList = ArcTan @@ (positions[[i]] - armCenter) & /@ positions
    2. then differences, accumulations, frame quantization, etc.
    3. similarly for plenghtArm

    you can build a single table of {angle_i, length_i}:

    data = {θ, ℓ} /. Thread[{θ, ℓ} -> Transpose@{ ArcTan @@@ (positions - armCenter), Norm /@ positions - (106.8 - lengthInitialArm) }];

    And then do your frame–subdivision logic on the two columns in one go.

    4. Factor out “drawArm[{angle_, length_}]”

    You repeat the entire Graphics[{…BezierCircleArc…, Line[...,], …}, …] block once per frame. Instead define

    drawArm[{θ_, ℓ_}] := Module[{armShape, clawShape}, armShape = { BezierCircleArc[{ℓ + 16.8, 0}, 20, {2.57, 3.72}], Line[{{0, 12.5}, {ℓ, 12.5}, {ℓ, 10.87}}], Line[{{0,-12.5}, {ℓ,-12.5}, {ℓ,-10.87}}], {EdgeForm[Black], GrayLevel[.84], Disk[{0,0},18]}, {EdgeForm[Black], GrayLevel[.50], Disk[{0,0},6]} }; clawShape = (* same idea *) GeometricTransformation[ {armShape, clawShape}, RotationTransform[θ Degree, {0,0}] ] ];

    Then your animation frames are simply

    frames = Table[ Graphics[ {boxGoal, pieces, piecesFinal, drawArm[{angListAnim[[i]], plenghtArmAnim[[i]]}]}, Axes->True, PlotRange->{{-40,400},{-90,250}}, ImageSize->500 ], {i, numberTotalFrames} ];

    5. Use built-ins / higher-order functions

    1. Nearest: 
      nrst = Nearest[posList -> "Index"]; i = First@nrst[pCurrent];
    2. FoldList or NestList to build your route in one expression.
    3. Subdivide already returns the full list of points for you, so you can pull off the “Most” trick later.
    4. Riffle can interleave stops automatically: 
      Riffle[ subdividedFrames, ConstantArray[restStops, framesClaws] ]

    6. Put it all inside a Module or DynamicModule

    So you can

    • avoid leaking p1,p2,…,u,…,claw1a,… into Global`.
    • clear everything with one ClearAll[myAnimation].
    • expose only a small number of parameters (posPieces, rClaws, lengthInitialArm, etc.).
    New contributor
    Ahamad is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
    \$\endgroup\$

      Start asking to get answers

      Find the answer to your question by asking.

      Ask question

      Explore related questions

      See similar questions with these tags.