Halfing an "array" until only individuals are left

Question

I have created an "array" of sorts using

For[i = 1, i <= Length[vector], i++,
  codes[i] = {}
  ];

The vector is a vector of probabilities, the sum of the vector is 1. I want to start halfing the vector and after each halfing, I want to add a number to the appropriate codes[i] variable. Meaning I half the vector, then I half the halves, etc. etc., until only individuals are left, and that is where the program ends, with each codes[i] filled with appropriate numbers. The halfing is done based on the sums of probabilities, not the length of the vector, so a 6 item vector could be halfed into 2 and 4 items.

I have tried looping the halfing, but of course, it cuts it, assigns numbers, and then starts halfing the first half, and ignores the second, from where it progresses, and only a small part of the vector is done correctly in the end.

total = 1;
sum = 0;
For[i = 1, sum < (total/2), i++,    
  sum = sum + vector[[i]];
  cut = i;
  ]; 

To cut a vector in half I run a cycle, summing the probabilities in the vector until the sum is greater or equal to half of what I need. The value of total is 1, because the sum of all the probabilities is 1, therefore I run a cycle adding up until the sum is greater than 0.5, then I save the index of the last number, and I run more cycles that fill the codes[i] vectors with numbers. I fill them with 0s and 1s, so I fill codes[i] with 0s up until the cut variable, then I fill the rest with 1s.

Is it possible to make such a loop, where it completes the entire vector?

Answer 1

ClearAll[splitF, codeF]

splitF = ReplaceRepeated[lst : {_?NumericQ, __?NumericQ} :> 
    TakeDrop[lst, 1 + LengthWhile[Accumulate[Normalize[lst, Total]], # < .5 &]]];

codeF = Position[splitF@#, {_?NumericQ}] - 1 &;

splitF splits an input list repeatedly until all sublists are singletons. A non-singleton list is first normalized (so that its sum is 1) and accumulated and then split when accumulated total exceeds the threshold .5.

codeF uses the position indices as the code for each singleton sublist.

Examples:

vec1 = {.4, .3, .2, .1};
vec2 = {.3, .3, .2, .1, .1};
vec3 = {.3, .1, .1, .1, .1, .1, .1, .1};
SeedRandom[777]
vec4 = ReverseSort@Normalize[RandomReal[1, 8], Total];

Grid[Prepend[Column /@ {#, splitF@#, codeF@#} & /@ {vec1, vec2, vec3,  vec4}, 
  {"vec", "splitF@vec", "codeF@vec"}], Dividers -> All]

We can pad the codes on the left (by repeating the left-most digit) or right (by repeating the right-most digit) to get equal-length codes:

ClearAll[padLeft, padRight, codeFL, codeFR]

padLeft = PadLeft[#, Automatic, \[FormalX]] /. 
    l : {Longest[\[FormalX] ..], a_, b___} :> (l /. \[FormalX] -> a) &;

padRight = PadRight[#, Automatic, \[FormalX]] /. 
    l : {b___, a_, Longest[\[FormalX] ..]} :> (l /. \[FormalX] -> a) &;

codeFL = padLeft[Position[splitF@#, {_?NumericQ}] - 1] &;

codeFR = padRight[Position[splitF@#, {_?NumericQ}] - 1] &;
Grid[Prepend[Column/@ {#, splitF @ #,  codeF @ #, codeFL @ #, codeFR @ #} & /@ 
     {vec1, vec2, vec3, vec4},
   {"vec", "splitF@vec", "codeF@vec", "codeFL@vec", "codeFR@vec"}], Dividers -> All]

SeedRandom[777]
vec5 = ReverseSort@Normalize[RandomReal[1, 30], Total];

Row[ArrayPlot[ToExpression[#] @ vec5, PlotLabel -> Style[#, 16], 
    ImageSize -> 1 -> 20, 
    FrameTicks -> {{Transpose[{Range @ Length @ vec5, 
         Row /@ ToExpression[#] @ vec5}], None}, 
       {All, All}}] & /@ 
    {"codeF", "codeFL", "codeFR"}, 
  Spacer[20]]