4
$\begingroup$

I have shuffled and used the output of Range[20] in order to create this minimal example:

t = {19, 4, 12, 1, 17, 13, 7, 14, 10, 11, 6, 18, 20, 15, 16, 3, 8, 5, 2, 9};

I would like to successively apply a function to select parts of this list and remove the entries selected. Let's say that the function is TakeLargest[#,UpTo[4]]&. I would like to keep taking UpTo the four largest elements till the list is empty. Here is my code for it.

t = {19, 4, 12, 1, 17, 13, 7, 14, 10, 11, 6, 18, 20, 15, 16, 3, 8, 5, 
   2, 9};
Module[{temp = t, pos, res},
 Reap[While[Length@temp > 0,
    pos = Flatten@(Position[temp, #] & /@ TakeLargest[temp, UpTo[4]]);
    Echo[pos, "pos="];
    res = {temp[[Sort@pos]], 
      ReplacePart[temp, List /@ pos -> Nothing]};
    Echo[res, "res="];
    Sow[First@res];
    temp = Last@res]
   ][[-1, 1]]
 ]

enter image description here


Many variations are possible with regards to order. Here in this example, I have maintained the order in which the entries are extracted as well as retained at each iteration in both the lists.

The number of entries chunked at each iteration depends on the function applied and is typically not known in advance.

Question(s)

  • I was wondering if there is a more functional way of doing this type of list chunking?

  • Can this be done using a built-in function?

  • Is there a standard name for this operation in functional programming?

Thanks for your help and suggestions in advance.

$\endgroup$
1
  • $\begingroup$ When the reomval operation respects an ordering relation, and all removals use that same relation, then this can be done using a priority queue. This is now a data structure built into the language; see ref/datastructure/PriorityQueue in the Documentation Center . Also there is a reference implementation in the Wolfram Function Repository. $\endgroup$ Apr 4, 2022 at 14:26

4 Answers 4

8
$\begingroup$

You can do this using NestWhileList. Inside this function you need TakeLargest and the Complement, to get rid of the taken elements:

t = {19, 4, 12, 1, 17, 13, 7, 14, 10, 11, 6, 18, 20, 15, 16, 3, 8, 5, 2, 9};

NestWhileList[{tmp = TakeLargest[#[[2]], 4], 
    Complement[#[[2]], tmp]} &, {{}, t}, Length[#[[2]]] >= 4 &][[2 ;;,
   1]]

(* {{20, 19, 18, 17}, {16, 15, 14, 13}, {12, 11, 10, 9}, {8, 7, 6, 
  5}, {4, 3, 2, 1}} *)

NestWhileList will return a list of tuples, where the first element are the 4 largest values and the second elements are the remaining values. We therefore only need the first element. We get rid of the first element of the output, because this is simply the input. All this is achieved by [[2;;,1]]


EDIT by @Syed

Thanks for your answer.

  1. The solution uses set operations (i.e., Complement) and therefore sorting takes place.

  2. Since the list may not be exactly divisible by the chunk size, I have made slight modifications to grab the leftover items. For instance for the case of a list with one more item 22 at location -7:

t = {19, 4, 12, 1, 17, 13, 7, 14, 10, 11, 6, 18, 20, 15, 22, 16, 3, 8,
    5, 2, 9};
NestWhileList[
  {tmp = TakeLargest[#[[2]], UpTo[4]], Complement[#[[2]], tmp]} &
  , {{}, t}
  , Length[#[[2]]] > 0 &][[2 ;;, 1]]
{{22, 20, 19, 18}, {17, 16, 15, 14}, {13, 12, 11, 10}, {9, 8, 7, 
  6}, {5, 4, 3, 2}, {1}}

To understand the [[2;;,1]], use Grid at first to see the outputs at the successive stages of NestWhileList:

NestWhileList[
  {tmp = TakeLargest[#[[2]], UpTo[4]], Complement[#[[2]], tmp]} &
  , {{}, t}
  , Length[#[[2]]] > 0 &] // Grid

enter image description here

$\endgroup$
3
$\begingroup$

I'll just answer your first bullet point.

Evaluation code:

eval[func_]:=
ReleaseHold[Hold@func/.{
  f -> (TakeLargest[#, UpTo@4] &), 
  list -> {19,4,12,1,17,13,7,14,10,11,6,18,20,15,16,3,8,5,2,9}}
]
SetAttributes[eval, HoldAll]

First attempt:

eval@
  NestWhile[
   {Append[#[[1]],#[[2]][[First /@ #2]]],
    Delete[#[[2]], #2]} &
   [#,Position[#[[2]], Alternatives @@ f@#[[2]]]] &,
  {{},list},
  #[[2]] != {} &][[1]]

The NestWhile iterates on lists that contain {{chunks so far},{elements to go}}. Naturally the start is {{},list}. Keep going until the {elements to go} is empty. At each step, Append the new chunk and Delete them (Alternatives@@ is the magic thing here).

Second attempt:

eval@
 Reap[NestWhile[
  l \[Function] 
   DeleteCases[l, 
   Alternatives @@ Sow@SortBy[f@l, Position[l, #] &]], 
  list, # != {} &]][[2, 1]]

similar, but using Reap/Sow. You can of course sort afterwards

eval[
SortBy[#, Position[list, #] &] & /@ 
 Reap[NestWhile[l \[Function] DeleteCases[l, 
  Alternatives @@ Sow@f@l],
 list, # != {} &]][[2, 1]]
]
$\endgroup$
1
  • $\begingroup$ Thanks for your effort, I will be studying your solution. $\endgroup$
    – Syed
    Apr 2, 2022 at 9:25
2
$\begingroup$

A start, using Sow and Reap:

Edit

delSow[{x_List,y_List}]:= (Sow[x[[y]]];Delete[x,List/@y])

g=Function[{x,y},{x,Sort@TakeLargest[x->"Index", UpTo[y]]}]

(Reap@NestWhile[delSow@g[#,4]&, t, Length@#>1&])[[2]]//Catenate

(*{{19, 17, 18, 20}, {13, 14, 15, 16}, {12, 10, 11, 9}, {7, 6, 8, 5}, {4, 1, 3, 2}} *)

(Reap@NestWhile[delSow@g[#,7]&, t, Length@#>1&])[[2]]//Catenate

(* {{19, 17, 14, 18, 20, 15, 16}, {12, 13, 7, 10, 11, 8, 9}, {4, 1, 6, 3, 5, 2}} *)

Original Answer

f=Function[{x,y},(Sow[x[[#]]];Delete[x,List/@#])&@Sort@TakeLargest[x->"Index", UpTo[y]]]

Examples

Reap[NestWhile[f[#,4]&, t, Length@#>1&]][[2]]//Catenate


(* {{19, 17, 18, 20}, {13, 14, 15, 16}, {12, 10, 11, 9}, {7, 6, 8, 5}, {4, 1, 3, 2}} *) 


Reap[NestWhile[f[#,7]&, t, Length@#>1&]][[2]]//Catenate

{{19, 17, 14, 18, 20, 15, 16}, {12, 13, 7, 10, 11, 8, 9}, {4, 1, 6, 3, 5, 2}}
$\endgroup$
1
  • 1
    $\begingroup$ I am not familiar with x -> "Index". Could you please say more or point me to a link. I am amazed at the brevity of your code. (ok never mind, I have discovered it in the docs, but will have to study it further). Thanks for your answer. $\endgroup$
    – Syed
    Apr 3, 2022 at 10:23
1
$\begingroup$

You can achieve the same result simply by using Partition on the (reverse) sorted list:

Partition[ReverseSort@list,UpTo@4]
(* {{19,18,17,16},{15,14,13,12},{11,10,9,8},{7,6,5,4},{3,2,1}} *)

(Note that I removed the 20 from the list to show that it works when the length is not divisible by four)

If you want to reproduce the order of the original list, you can reapply it using PositionIndex as lookup for SortBy:

 SortBy[PositionIndex@list]/@Partition[ReverseSort@list,UpTo@4]
(* {{19,17,18,16},{12,13,14,15},{10,11,8,9},{4,7,6,5},{1,3,2}} *)
$\endgroup$
2
  • 2
    $\begingroup$ The idea is that the points can be collected using an algorithm and their partitions are not readily known. The TakeLargest example was a toy example. Look at my original post, where I keep the order in tact. So it is not possible in general to sort points in order or even know how many will be sifted by the algorithm per iteration. $\endgroup$
    – Syed
    Apr 2, 2022 at 20:10
  • $\begingroup$ @Syed sorry, it seems my reading of the question was too superficial - for your actual application, DanielHuber's answer is probably the best $\endgroup$
    – Lukas Lang
    Apr 2, 2022 at 20:15

Your Answer

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

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