5
\$\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\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.