Search code examples
optimizationnestedcoordinateswolfram-mathematicadelete-row

How can I conditionally remove elements from level 1 of a nested list given the value of a level 2 element?


Platform: Mathematica

I have a table of x and y coordinates belonging to individual connected paths (trajectories):

{{Trajectory, Frame, x, y}, {1, 0, 158.22, 11.519}, {1, 1, 159.132, 11.637}, ... {6649, 1439, 148.35, 316.144}}

in table format it would look like this:

Trajectory     Frame     x        y
------------------------------------------
1              0         158.22   11.519
1              1         159.13   11.637
1              2         158.507  11.68
1              3         157.971  11.436
1              4         158.435  11.366
1              5         158.626  11.576
2              0         141      12       remove this row, path too short!
2              1         143      15       remove this row, path too short!
2              2         144      16       remove this row, path too short!
2              3         147      18       remove this row, path too short!
3              0         120      400
3              1         121      401
3              2         121      396
3              3         122      394
3              4         121      392
3              5         120      390
3              6         124      388
3              7         125      379
...

I want to remove any elements/rows where the total length of the trajectory is less than "n" frames/rows/elements (5 frames for this example). The list is ~80k elements long, and I want to remove all the rows containing trajectories under the specified threshold.

For the given example, trajectory 2 exists across only 4 frames, so I want to delete all rows for Trajectory 2.

I am new to Mathematica and I don't even know where to begin. I thought perhaps creating a list that contains the trajectory numbers that have a Count[] value less than the threshold, then conditionally eliminating any elements that follow that pattern with something like DeleteCases[], but I wasn't able to get very far given my limited syntax knowledge.

I appreciate your help and look forward to a solution!


Solution

  • table = {{"Trajectory", "Frame", "x", "y"},
       {1, 0, 158.22, 11.519}, {1, 1, 159.13, 11.637},
       {1, 2, 158.507, 11.68}, {1, 3, 157.971, 11.436},
       {1, 4, 158.435, 11.366}, {1, 5, 158.626, 11.576},
       {2, 0, 141, 12}, {2, 1, 143, 15}, {2, 2, 144, 16},
       {2, 3, 147, 18}, {3, 0, 120, 400}, {3, 1, 121, 401},
       {3, 2, 121, 396}, {3, 3, 122, 394}, {3, 4, 121, 392},
       {3, 5, 120, 390}, {3, 6, 124, 388}, {3, 7, 125, 379}};
    
    traj = First /@ Rest[table];
    n = 5;
    under = First /@ Select[Tally[traj], Last[#] < n &];
    discard = Flatten[Position[table[[All, 1]], #] & /@ under];
    newtable = Delete[table, List /@ discard]
    

    or alternatively, for the last two lines, this could be faster

    discard = Position[table[[All, 1]], _?(MemberQ[under, #] &)];
    newtable = Delete[table, discard]