How to implement If criteria for the NestList-Function

Question

I have a function which bisects a list in two parts recursively. Unfortunately I have to select a number of iterations for the NesList-function which is just an approximate solution working for eight list constituents. The folliwing shows the procedure:

Some list with numbers. The brackets are needet so that the function recognizes the whole list as one object to bisect.

t = {Range[1, 8]}   

f1 is the function which bisects the list.

 f1[list_] := {list[[1 ;; Floor@(Length@list/2)]], 
      list[[Floor@(Length@list/2) + 1 ;;]]}

f2 applies this recursively with the approximate number of iterations.

f2[l_] := NestList[Flatten[Map[f1, #, 1], 1] &, l, 
      Floor@(Log@(Length @@ t)) + 1]

The output for the list would be:

func[t] 

{{{1, 2, 3, 4, 5, 6, 7, 8}}, {{1, 2, 3, 4}, {5, 6, 7, 8}}, {{1, 
   2}, {3, 4}, {5, 6}, {7, 
   8}}, {{1}, {2}, {3}, {4}, {5}, {6}, {7}, {8}}} 

In the case of 8 Items in the ist it works perfectly out. But the Criterion in the NestList, Floor@(Log@(Length @@ t)) + 1 does not work for higher numbers. Also the bisection should happen if and only if the item or let's say the sublist fufills the criterion Length[sublist]>1 so strictly greater meaning at least two eleements.

I thought of If statement but I do not understand how to incorporate it into my function. Maybe there are other more elegant ways like NestWhileList?.

Would be glad if someone has experience with this. Thank you very much!

Answer 1

Here's the easiest way to do it:

f[list : {_}] := list;
f[list_List] := TakeDrop[list, Floor[Length[list]/2]]
NestList[Flatten[Map[f, #], 1]&, {Range[8]}, 3]

It's also worth taking a look at NestWhileList if you want to keep nesting till there's nothing left to do. For example:

NestWhileList[Flatten[Map[f, #], 1] &, {Range[8]},
  !MatchQ[#, {{_}..}] &
]

Edit

Actually, FixedPointList is even easier:

Clear[f]
f[list : {_}] := {list};
f[list_List] := TakeDrop[list, Floor[Length[list]/2]]
FixedPointList[Flatten[Map[f, #], 1] &, {Range[8]}]

Answer 2

Look up FixedPointList in the docs and try the following for different Range[..] values.

f[k_List] := TakeDrop[k, Floor[Length[k]/2]]
FixedPointList[
  Flatten[Map[f, #] /. {} -> Nothing, 1] &, {Range[13]}] // MatrixForm