# Joining constant arrays determined by a subsequence of contiguous block of ones

I have the following:

data = {15, 25, 35, 45, 55, 65, 75, 85, 95, 105};
selector = {0, 1, 1, 0, 1, 1, 1, 0, 0, 0};


I want to create the following list from data using selector

output = {0, 15, 15, 0, 45, 45, 45, 0, 0, 0};


The rule is given a contiguous block of 1s, output is created by selecting the element from data in the position before the first 1 and creating a constant array of that element that is the same length as that block of 1s. Else output is zero. Note: selector[[1]] is always 0

My solution is the following, but it is not very "Mathematica".

foo[data_, selector_] :=
Block[
{
output = ConstantArray[0, Length[data]]
},
Do[
Which[
selector[[i]] == 0 && selector[[i + 1]] == 1,
output[[i + 1]] = data[[i]],
selector[[i]] == 1 && selector[[i + 1]] == 0,
output[[i + 1]] = 0,
1 + 1 == 2,
output[[i + 1]] = output[[i]]
],
{i, Length[data] - 1}
];
output
];

foo[data, selector] == output


True

Is there a cleaner / quicker way of solving this?

Timing

SeedRandom[1];
n = 100000;
selectorBig = RandomInteger[1, n];
selectorBig[[1]] = 0;
dataBig = RandomInteger[{15, 105}, n];

outputBig=foo[dataBig, selectorBig]; // RepeatedTiming // First


0.137602

EDIT

Adding in a compiled version for completeness (150x faster)

fooC =
Compile[
{
{data, _Integer, 1},
{selector, _Integer, 1}
},
Block[
{
output = ConstantArray[0, Length[data]]
},
Do[
Which[
selector[[i]] == 0 && selector[[i + 1]] == 1,
output[[i + 1]] = data[[i]],
selector[[i]] == 1 && selector[[i + 1]] == 0,
output[[i + 1]] = 0,
1 + 1 == 2,
output[[i + 1]] = output[[i]]
],
{i, Length[data] - 1}
];
output
],
CompilationTarget -> "C",
RuntimeOptions -> "Speed"
];

fooC[data, selector] == output
fooC[dataBig, selectorBig] === outputBig // RepeatedTiming


True

{0.000815153, True}

Something like this might be cleaner, but less performant:

foo[data_, selector_] :=
Flatten[{0, ConstantArray[data[[#1]], #2 - #1]} & @@@ SequencePosition[selector, {0, 1 ...}]]


This is more performant:

foo[data_, selector_] :=
Flatten[
(#[[1]] - #) & /@
Split[data*(1 - selector), 0 == #2 &]]


Old

This was incorrect for certain selectors.

foo[data_, selector_] :=
Flatten[
{0, ConstantArray[#[[1]], Length[#] - 1]} & /@
TakeList[data, Length /@ DeleteCases[Split[selector, LessEqual], {0 ..}]]],
Length[data]]

• I think the second one fails with data={15, 19, 39, 46, 99, 29, 48, 78, 30, 83} and selector={0, 1, 0, 1, 0, 0, 0, 1, 0, 1} Commented Sep 15, 2023 at 7:04
• Okay, you should add that test case to your question. The way it was written, I assumed that strings of more than 1 zero would only happen at the end of the selector. Commented Sep 15, 2023 at 10:24
• yes, given the randomized example you provided, I absolutely should not have made that assumption. It's just always clearer with explicit test cases. I saw a section with "Timing" and didn't really pay attention to it because I was trying to solve the functional problem. I made the assumption. It was a bad assumption. It's also a very predictable/human thing to do. So, it's always good to provide explicit test cases. Commented Sep 15, 2023 at 10:53
• I apologise that it wasn't clear, but I did include a test case of selectorBig and dataBig in addition to the original example. (reposting comment as I could not edit it) Commented Sep 15, 2023 at 10:54
• agreed that I could have given a more general test case as an example Commented Sep 15, 2023 at 10:55

### 1.

f1 = #2 ReplaceAll[{
x : {_} :> Splice @ x,
x : {_Integer, __} :> Splice[Table[First @ x, Length @ x]]}]@
Split[# (1 - #2), #2 == 0 &] &;

f1[data, selector]

{0, 15, 15, 0, 45, 45, 45, 0, 0, 0}


### 2.

f2 = #2 MapApply[Splice[Table[#, Length@{##}]]&]@ Split[# (1 - #2), #2 == 0 &]&;

f2[data, selector]

{0, 15, 15, 0, 45, 45, 45, 0, 0, 0}

• (+1) Nice, @kglr! :-) Commented Sep 15, 2023 at 4:56
• (+1) Never seen Splice before! Commented Sep 15, 2023 at 7:11
foo4[data_, selector_] := FoldList[helper,({0}~Join~Most[data])*selector];


Where

helper[0, y_] := y; (* take the new value *)
helper[x_, y_] := x; (* use the previous value *)
helper[x_, 0] := 0;
helper[0, 0] := 0;


Elaboration: I realised that I get close to answer if I offset the data and multiply it with the selector ({0}~Join~Most[data])*selector

{0, 15, 25, 0, 45, 55, 65, 0, 0, 0}

I couldn't quite work out how to then make the non-zeroes take their previous values but some inspiration hit with a helper function

foo4[data, selector] == output


True

• This is 10x faster than foo but 10x slower than fooC Commented Sep 15, 2023 at 7:24

My attempt is as follows:

FillWithPreviousValue[list_, selector_] :=
Module[{previousValue = None, resultList = {}},
previousValue = #1, AppendTo[resultList, previousValue]]) &, {list, selector}];
resultList]


Testing the function:

data = {15, 25, 35, 45, 55, 65, 75, 85, 95, 105};
selector = {0, 1, 1, 0, 1, 1, 1, 0, 0, 0};
res = {0, 15, 15, 0, 45, 45, 45, 0, 0, 0};

FillWithPreviousValue[data, selector] === res

(*True*)


data2 = {15, 19, 39, 46, 99, 29, 48, 78, 30, 83};
selector2 = {0, 1, 0, 1, 0, 0, 0, 1, 0, 1};
res2 = {0, 15, 0, 39, 0, 0, 0, 48, 0, 30};

FillWithPreviousValue[data2, selector2] === res2

(*True*)

• I get some error messages with data={15, 19, 39, 46, 99, 29, 48, 78, 30, 83} and selector={0, 1, 0, 1, 0, 0, 0, 1, 0, 1} Commented Sep 15, 2023 at 6:56
• See the update, please! :-) Commented Sep 16, 2023 at 0:21