2
$\begingroup$

I can't seem to wrap my head around the syntax for how to rewrite this chunk of code I have using a while loop, and would appreciate some help. I'm going through a list and am grouping the values into clusters based off distance at different time steps. Now for this particular time step,since I know the number of groupings, so I was able to write the code as such, and store these five groups in bFill like so:

update = {215.747, 215.238, 213.231, 213.162, 212.202, 212.17, 211.369,211.341, 211.017, 210.873, 210.802, 210.649, 210.586, 210.484, 210.4, 210.32, 210.287, 210.198, 210.18, 210.048, 210.047, 210.01, 209.971, 209.958, 209.889, 209.846, 209.819, 209.815, 209.77, 209.754, 209.538, 209.498, 209.452, 209.296, 209.162, 209.136, 209.039, 209.015, 209.007, 208.935, 208.78, 208.671, 208.555, 208.51, 208.3, 208.169, 208.143, 137.806, 137.792, 137.68, 136.943, 136.324, 136.087, 135.653, 135.405, 135.31, 134.587, 132.697, 131.655, 131.253, 124.246, 123.571, 123.543, 123.357, 123.277, 123.079, 122.833, 122.53, 122.433, 122.377, 122.21, 122.192, 122.174, 122.109, 122.097, 121.866, 121.632, 121.619, 121.519, 121.51, 121.415, 121.392, 121.362, 121.303, 121.075, 121.048, 120.652, 120.602, 120.282, 120.209, 119.208, 119.08, 118.918, 118.843, 118.836, 118.655, 118.628, 118.481, 117.876, 117.574, -165.322, -165.584, -165.791, -166.015, -166.172, -166.33, -168.422, -168.681, -169.081, -169.347, -169.633, -170.288, -170.564, -170.79, -172.107, -172.116, -173.292, -173.563, -173.587, -174.051, -174.143, -174.261, -174.274, -174.346, -174.528, -174.978, -175.021, -175.079, -175.096, -175.14, -175.165, -175.295, -175.69,-175.802, -175.88, -175.909, -176.06, -176.177, -176.386, -176.464, -176.547, -176.55, -177.538, -178.261, -178.486, -210.531, -211.429,-211.476, -211.726, -211.752, -211.851, -211.886, -211.891, -212.046, -212.12, -212.327, -212.75, -212.873, -213.008, -213.154, -213.261, -213.275, -213.438, -213.682, -213.834, -213.921, -213.949, -213.98, -213.986, -214.185, -214.307, -214.389, -214.422, -214.763, -214.91,-215.697, -215.767, -215.799, -216.192, -216.203, -216.217, -216.236, -216.256, -216.412, -216.518, -216.796, -216.841, -216.873, -217.059, -217.2, -217.382, -217.454, -217.576, -217.655, -217.752, -218.143, -218.216, -218.301, -218.343, -224.348};
diam = 14.2535;
bFill = {};
branch = {};
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, update[[len + 1]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, list[[len + 1]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, list[[len + 1]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, list[[len + 1]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, list[[len + 1]], {All, diam}];

Now for this code I would "know" that I'm done when Length@update == 0, which is the case in the last step, so I was thinking of trying to re-write it like so:

(* update and diam same as from previous *)
bFill = {};
branch = {};

While[Length@update > 0,
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, update[[len + 1]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
]

but this just ends up throwing out all sorts of errors, so clearly I'm not writing it correctly. In the end, I'm expecting bFill to look like so:

[In]:= bFill
[Out]:= {{215.747, 215.238, 213.231, 213.162, 212.202, 212.17, 211.369,211.341, 211.017, 210.873, 210.802, 210.649, 210.586, 210.484,210.4, 210.32, 210.287, 210.198, 210.18, 210.048, 210.047, 210.01,209.971, 209.958, 209.889, 209.846, 209.819, 209.815, 209.77,209.754, 209.538, 209.498, 209.452, 209.296, 209.162, 209.136,209.039, 209.015, 209.007, 208.935, 208.78, 208.671, 208.555,208.51, 208.3, 208.169, 208.143}, {137.806, 137.792, 137.68, 136.943, 136.324, 136.087, 135.653, 135.405, 135.31, 134.587, 132.697, 131.655, 131.253, 124.246, 123.571}, {123.543, 123.357,123.277, 123.079, 122.833, 122.53, 122.433, 122.377, 122.21, 122.192, 122.174, 122.109, 122.097, 121.866, 121.632, 121.619, 121.519, 121.51, 121.415, 121.392, 121.362, 121.303, 121.075, 121.048, 120.652, 120.602, 120.282, 120.209, 119.208, 119.08, 118.918, 118.843, 118.836, 118.655, 118.628, 118.481, 117.876,117.574}, {-165.322, -165.584, -165.791, -166.015, -166.172,-166.33, -168.422, -168.681, -169.081, -169.347, -169.633, -170.288, -170.564, -170.79, -172.107, -172.116, -173.292, -173.563, -173.587, -174.051, -174.143, -174.261, -174.274, -174.346, -174.528, -174.978, -175.021, -175.079, -175.096, -175.14, -175.165, -175.295, -175.69, -175.802, -175.88, -175.909, -176.06, -176.177, -176.386, -176.464, -176.547, -176.55, -177.538, -178.261, -178.486}}

I can't seem to make sense to myself how to re-write this in a recursive fashion, so any help would be appreciated.

Edit: I was just trying a simple While loop like so:

l = Table[1, 5];
n = 1;
While[
Length@l > 0, n = n*Length@l;
l = Delete[l, 1]
]
n
(* 120 *)

which works, just as a sanity check that I can indeed use the length of update as the condition for the While loop. I thought maybe with some moving things around it might work:

While[
Length@update > 0, 
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, update[[len + 1]], {All, diam}]; 
AppendTo[bFill, branch];
update = DeleteCases[update, Alternatives @@ branch]
]

but again, same error. I noticed that while bFill[[1]] contained the values I expected, bFill[[2]] contained more values (43 vs the 15 it should have had) and missed some that values I would have expected it to pick up. SO something about how this is being written isn't translating correctly when I try to put it into a While loop.

Improve this question
$\endgroup$
14
  • 1
    $\begingroup$ The condition in the first argument of While is checked before the second argument is executed. So the loop does not start if update is undefined or {}. It should suffice to define update={1} before the loop. $\endgroup$
    – Henrik Schumacher
    Jun 21, 2020 at 19:27
  • 3
    $\begingroup$ "Pro" tip: doing AppendTo in a loop in Mathematica is doomed to be slow when the list you accumulate becomes long... Either pre-allocate the list first using e.g. ConstantArray and then modify elements, or better, use Table. $\endgroup$
    – Marius Ladegård Meyer
    Jun 21, 2020 at 19:39
  • $\begingroup$ @HenrikSchumacher update and diam are defined outside of the While loop, so I don't understand why this would be a problem or why update would be redefined as update={1} - I need the data that is initially stored in update. $\endgroup$
    – Illari
    Jun 21, 2020 at 20:28
  • 2
    $\begingroup$ In the case where the number of elements are not/cannot be known in advance, the idiomatic way is to use Reap + Sow. $\endgroup$
    – Marius Ladegård Meyer
    Jun 21, 2020 at 20:35
  • 1
    $\begingroup$ Replace AppendTo inside the While by Sow, and wrap the whole thing in a Reap on the outside. $\endgroup$
    – Marius Ladegård Meyer
    Jun 21, 2020 at 20:57

3 Answers 3

Reset to default
4
$\begingroup$

Here are a couple small improvements, first!

  • DeleteCases[list1, Alternatives @@ list2] is, if list2 is full of literals and not pattern objects, as is the case here, the same as Complement[list1, list2], which gives all those elements of list1 not in list2.
  • Instead of accessing a whole table and recalculating len from scratch each time we pass through the while loop, we can just tack on the length of the latest branch each time we compute branch, as len += Length[branch]. (And we start with a nice len = 0 before entering the loop.)
  • Instead of calculating the length of update in the while loop check each time, you can just check if it's the empty list: update != {}. This would only matter if update were absolutely enormous, though (and/or we were going through many, many times).
  • Instead of using AppendTo, it's quicker to Sow and Reap—or to build up things by nesting, like v = {newstuff, v} and flatten later (if we don't care about list structure, but we do).

Otherwise, your loop is basically right! But you've made one error: each time you pass through the loop, you delete everything you don't want anymore from update. So you don't want the len + 1'th element of update—you want the first! That is, you want Nearest[update, First[update], {All, diam}].

So, it turns out it's not a loop problem, it's a structure problem; and it turns out we don't even actually need to calculate the length of bfill anymore.

Putting it together with Reap and Sow we'd have

Reap[
 While[
  update != {}, 
  branch = Nearest[update, First[update], {All, diam}]; 
  Sow[branch];
  update = Complement[update, branch];
 ]
]

The output of Reap is weird: used like this, it's a list {output, {{SowedElements}} }. Here the output is Null since we end with a ;. So we'd need to actually use First@Last@Reap[...] or something equivalent.

I'm personally curious if there's a way to implement this loop with only Sow and Reap while Scanning through the list (no While loop), using different tags for each cluster (that's why there's the extra list enclosure in the output of Reap), and if it's faster or slower!

Update: I think I might have misunderstood the intended output—I assumed you wanted disjoint clusters, as opposed to a cluster for each element. If you want a cluster for each element, there's a really slick way of doing it by simply mapping the "cluster-creating function" over the entire list of data:

Nearest[update, #, {All,diam}] & /@ update

That would be the entire thing! :)

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ This is an interesting answer, and I thank you for giving improvement suggestions! I'll definitely be incorporating them . I did notice while comparing that the two methods seem to give slightly different results for the clusters, and I also noticed that it seems to start at the top cluster, then go to the bottom and work its way up? Pretty interesting! For my own bookkeeping purposes, I need it that in the list it always goes cluster 1, 2, ..., n. But really thank you for taking the time to type this up, I never would have come up with something so neat, and I appreciate the improvements. $\endgroup$
    – Illari
    Jun 22, 2020 at 4:13
2
$\begingroup$

Too long for a comment, but this should get you started I think. Given your data, outputs 5 groups, first 4 match your example, I assume one was left off there since you state 5 elsewhere.

pos = 1;
tmp = {};
res2 = Reap[
   While[pos < Length@update, 
     Sow[tmp = 
       Cases[update[[pos ;;]], x_ /; update[[pos]] - x <= diam]];
     pos += (Length@tmp);];][[2, 1]];

Short/@res2

{{215.747,215.238,213.231,<<41>>,208.3,208.169,208.143},{137.806,137.792,137.68,<<9>>,131.253,124.246,123.571},{123.543,123.357,123.277,<<32>>,118.481,117.876,117.574},{-165.322,-165.584,<<41>>,-178.261,-178.486},
{-210.531,-211.429,-211.476,<<50>>,-218.343,-224.348}}

Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Thank you for this comment! I'll admit that it is a bit difficult for me to parse going through it step by step... I realised where I was going on when I was rewriting the code using For loop instead in addition to another comment, and will be answering with my For and While loop work-arounds, just in case it helps anyone (doubtful, but you never know...!) $\endgroup$
    – Illari
    Jun 21, 2020 at 23:04
2
$\begingroup$

Here's where I went wrong: so I am deleting elements from update while I also have a copy of update called list - I do nothing to this list. So I started rewriting the code using a For loop and I ended up having to put in this Break[], otherwise it would add a nonsense list to the list of lists (or I could always just delete the last element?) Regardless, the For loop:

list = update;
bFill = branch = uL = {};
len = 0;

For[i = 1, i <= 200, i += len;
branch = Nearest[update, list[[i]], {All, diam}];
update = DeleteCases[update, Alternatives @@ branch];
AppendTo[bFill, branch];
len = Length@branch;
AppendTo[uL, Length@update];
If[Last@uL == 0, Break[]]
]

Then, when I realised I needed to use list in the For loop in addition to @thorimur's comments, I was able to write the While loop like so:

list = update;
bFill = branch = uL = {};
len = 0;

While[Length@update > 0, 
len = Total[Table[Length@bFill[[i]], {i, Length@bFill}]];
branch = Nearest[update, list[[len + 1]], {All, diam}];
AppendTo[bFill, branch];
update = DeleteCases[update, Alternatives @@ branch]]

I'll be implementing @thorimur's comments re using Compliment and Length[Flatten[bfill,1]].

Thanks a lot everybody for suggestions and comments, this was really driving me nuts!

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.