# Simulation of a mechanical arm

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?