# Number of sign flips in list?

Given a list of signs:

list={1,1,-1,1,-1,-1,1,1,1,-1};


how to most conveniently and quickly determine the number of sign flips in the sequence?

flipNum[l_]:=Block[{num},
num=0;
Do[If[0>l[[i]]l[[i+1]],num=num+1;];,{i,1,Length[l]-1}];
If[0>l[[1]]l[[-1]],num=num+1;];
num
]


But I suspect there could exist a much quicker and more elegant solution in mathematica?

EDIT:

While it is true that the above code is very slow (takes 20 seconds in the benchmarks in the answers below), one can easily compile it:

flipNum = Compile[{{l, _Integer, 1}}, Block[{num}, num = 0;
Do[If[0 > l[[i]] l[[i + 1]], num = num + 1;];, {i, 1, Length[l] - 1}];
If[0 > l[[1]] l[[-1]], num = num + 1;];
num], CompilationTarget -> "C"]


With this the performance becomes:

SeedRandom[1234]
list = RandomChoice[{-1, 1}, 10000000];
AbsoluteTiming[flipNum[list]]


{0.282849, 5000678}

which makes it actually the most efficient solution without packaging the data.

If we do package the data:

SeedRandom[1234]
list = RandomChoice[DeveloperToPackedArray@{-1, 1}, 10^7];
AbsoluteTiming[flipNum[list]]


{0.224196, 5000678}

it gets a bit quicker, but loses in terms of performance to the "bitxor" and "subtract" solutions.

If your list doesn't contain 0 you can do

list = {1,1,-1,1,-1,-1,1,1,1,-1};

Total[Abs[Differences[Sign[list]]]]/2 + Boole[Sign[First[list]] != Sign[Last[list]]]

6


Accounting for the cyclic sign flip this way isn't as elegant, but in kglr's test it's much faster than using Append[list, First[list]].

• Note that my flipNum[list] returns 6, since the sign flip between first and last list element also counts. – Kagaratsch Feb 14 '18 at 21:29
• Add Abs[Sign[list[[1]]] - Sign[list[[-1]]]]/2 to the result to account for cyclic sign flips between first and last list elements. – Kagaratsch Feb 14 '18 at 22:49
• @Kagaratsch Ah, I didn't realize that was a requirement. See me edit. – Chip Hurst Feb 15 '18 at 0:32

Here's my version:

Total @ Unitize @ BitXor[list, RotateRight[list]]


6

Assuming the lists consist of only 1 and -1, then the BitXor function call will return -2 (for sign changes) and 0 otherwise. So, we can dispense with the Unitize part:

bitxor[list_] := -Total @ BitXor[list, RotateRight @ list]/2


This should be faster than the other answers as long as the input is packed. For example:

subtract[list_] := Total @ Unitize @ Subtract[list, RotateRight @ list]
differences[list_] := 1/2 Total[Abs[Differences[Sign[list]]]]+Boole[Sign[First[list]]!=Sign[Last[list]]]

data = RandomChoice[DeveloperToPackedArray @ {-1, 1}, 10^7];

r1 = bitxor[data]; //RepeatedTiming
r2 = subtract[data]; //RepeatedTiming
r3 = differences[data]; //RepeatedTiming

r1 === r2 === r3


{0.057, Null}

{0.077, Null}

{0.15, Null}

True

If the input isn't packed, then the BitXor approach becomes much slower, at least in M11.2.

list = {1, 1, -1, 1, -1, -1, 1, 1, 1, -1};

Total[Unitize[Subtract[list, RotateRight @ list]]]


6

Total @ Abs @ Subtract[list, RotateRight@list]/2


6

Length[Split[Append[list, list[[1]]]]] - 1


6

## Timings

### Functions

split = Length[Split[Append[#, #[[1]]]]] - 1 &;
fold = With[{f = First[#], r = Rest[#]},
Block[{o}, If[f == r[[-1]], o = {0, f}, o = {1, f}];
First[Fold[With[{c = #1[[1]], s1 = #1[[-1]], s2 = #2},
If[s1 == s2, {c, s2}, {c + 1, s2}]] &, o, r]]]] &;
bitxor = Total@Unitize@BitXor[#, RotateRight[#]] &;
bitxor2[list_] := -Total@BitXor[list, RotateRight@list]/2
subtract = Total@Unitize@Subtract[#, RotateRight@#] &;
subtract2 = Total@Abs@Subtract[#, RotateRight@#]/2 &;
differences = Total[Abs[Differences[Sign@#]]]/2 + Boole[Sign[First[#]] != Sign[Last[#]]]&;
flips = With[{q = Split[Positive[#]][[All, 1]]}, Length[q]-Boole[First[q] === Last[q]]]&;
partition = -Total[Cases[Apply[Times, Partition[#, 2, 1, {1, 1}], 1], Except[1]]] &;
flipNum[l_] := Block[{num}, num = 0;
Do[If[0 > l[[i]] l[[i + 1]], num = num + 1;];, {i, 1, Length[l] - 1}];
If[0 > l[[1]] l[[-1]], num = num + 1;];  num]
ProgressiveDifferences[list_] := Reverse[Differences[Reverse[list]]];
WrappingDifferences[list_] := Append[ProgressiveDifferences[list],
list[[Length[list]]] - list[[1]]]/2;
wrappingdifs = Total[Abs[WrappingDifferences[#]]] &;
count = Count[# + RotateRight@#, 0] &;
count2= Length[#] - Total[Abs[# + RotateRight@#]]/2 &;
listconvolve = Count[ListConvolve[{1, 1}, #, 1], 0] &;
listconvolve2 = Length[#] - Total[Abs[ListConvolve[{1, 1}, #, 1]]]/2 &;

funcs = {flips, split, fold, bitxor, subtract, subtract2, differences,
flipNum, partition, bitxor2, count,count2, listconvolve, listconvolve2, wrappingdifs};
labels = {"flips", "split", "fold", "bitxor", "subtract",
"subtract2", "differences", "flipNum", "partition", "bitxor2",
"count","countt2", "listconvolve", "listconvolve2", "wrappingdifs"};


### Timings for unpacked input

For unpacked input data, Alucard & Chip Hurst's listconvolve2 is the fastest among the methods posted so far followed by differences.

Version 9.0 on Windows 10 - 64bit

SeedRandom[1234]
list = RandomChoice[{-1, 1}, 10^7];
{timing, output} = Transpose[AbsoluteTiming[#[list]] & /@ funcs];
TeXForm @ Grid[Prepend[SortBy[Transpose[{labels, output, timing}], Last],
{"function", "output", "timing"}], Dividers -> All]


$$\begin{array}{|c|c|c|} \hline \text{function} & \text{output} & \text{timing} \\ \hline \text{listconvolve2} & 5000678 & 0.327872 \\ \hline \text{differences} & 5000678 & 0.392042 \\ \hline \text{subtract2} & 5000678 & 0.435157 \\ \hline \text{subtract} & 5000678 & 0.440169 \\ \hline \text{bitxor2} & 5000678 & 0.533418 \\ \hline \text{bitxor} & 5000678 & 0.536427 \\ \hline \text{count2} & 5000678 & 0.538431 \\ \hline \text{listconvolve} & 5000678 & 0.737962 \\ \hline \text{count} & 5000678 & 0.975595 \\ \hline \text{fold} & 5000678 & 1.226261 \\ \hline \text{split} & 5000678 & 1.455870 \\ \hline \text{flips} & 5000678 & 2.982931 \\ \hline \text{wrappingdifs} & 5000678 & 3.439143 \\ \hline \text{partition} & 5000678 & 7.361212 \\ \hline \text{flipNum} & 5000678 & 20.259868 \\ \hline \end{array}$$

Version 11.2 on windows 10-64bit

$$\begin{array}{|c|c|c|} \hline \text{function} & \text{output} & \text{timing} \\ \hline \text{subtract} & 5000678 & 0.459002 \\ \hline \text{subtract2} & 5000678 & 0.476543 \\ \hline \text{listconvolve2} & 5000678 & 0.501648 \\ \hline \text{count2} & 5000678 & 0.517032 \\ \hline \text{count} & 5000678 & 1.02226 \\ \hline \text{listconvolve} & 5000678 & 1.1516 \\ \hline \text{fold} & 5000678 & 1.35075 \\ \hline \text{split} & 5000678 & 1.42508 \\ \hline \text{flips} & 5000678 & 2.39839 \\ \hline \text{differences} & 5000678 & 3.14381 \\ \hline \text{wrappingdifs} & 5000678 & 3.23569 \\ \hline \text{bitxor} & 5000678 & 3.92984 \\ \hline \text{bitxor2} & 5000678 & 4.66418 \\ \hline \text{partition} & 5000678 & 5.09891 \\ \hline \text{flipNum} & 5000678 & 19.1239 \\ \hline \end{array}$$

### Timings for PackedArray input

Version 9.0 on Windows 10 - 64bit

Using a packed array as input, subtract2 is the fastest followed by subtract.

SeedRandom[1234]
list = RandomChoice[DeveloperToPackedArray@{-1, 1}, 10^7];
{timing, output} = Transpose[AbsoluteTiming[#[list]] & /@ funcs];
TeXForm @ Grid[Prepend[SortBy[Transpose[{labels, output, timing}], Last],
{"function", "output", "timing"}], Dividers -> All]


$$\begin{array}{|c|c|c|} \hline \text{function} & \text{output} & \text{timing} \\ \hline \text{subtract} & 5000678 & 0.211562 \\ \hline \text{count2} & 5000678 & 0.212565 \\ \hline \text{bitxor} & 5000678 & 0.242641 \\ \hline \text{listconvolve2} & 5000678 & 0.259692 \\ \hline \text{subtract2} & 5000678 & 0.295785 \\ \hline \text{bitxor2} & 5000678 & 0.326869 \\ \hline \text{differences} & 5000678 & 0.332885 \\ \hline \text{count} & 5000678 & 0.629674 \\ \hline \text{listconvolve} & 5000678 & 0.694850 \\ \hline \text{fold} & 5000678 & 1.269379 \\ \hline \text{split} & 5000678 & 2.291084 \\ \hline \text{wrappingdifs} & 5000678 & 3.368954 \\ \hline \text{flips} & 5000678 & 5.188834 \\ \hline \text{partition} & 5000678 & 8.494586 \\ \hline \text{flipNum} & 5000678 & 22.879290 \\ \hline \end{array}$$

Version 11.2 on windows 10-64bit(Alucard i5-6300u)

$$\begin{array}{|c|c|c|} \hline \text{function} & \text{output} & \text{timing} \\ \hline \text{bitxor2} & 5000678 & 0.159978 \\ \hline \text{count2} & 5000678 & 0.170289 \\ \hline \text{subtract2} & 5000678 & 0.176443 \\ \hline \text{bitxor} & 5000678 & 0.18276 \\ \hline \text{subtract} & 5000678 & 0.184796 \\ \hline \text{differences} & 5000678 & 0.344954 \\ \hline \text{listconvolve2} & 5000678 & 0.40738 \\ \hline \text{count} & 5000678 & 0.665442 \\ \hline \text{listconvolve} & 5000678 & 0.891994 \\ \hline \text{fold} & 5000678 & 1.42892 \\ \hline \text{split} & 5000678 & 1.64534 \\ \hline \text{flips} & 5000678 & 2.31116 \\ \hline \text{wrappingdifs} & 5000678 & 3.0645 \\ \hline \text{partition} & 5000678 & 5.5853 \\ \hline \text{flipNum} & 5000678 & 22.0245 \\ \hline \end{array}$$

• I have the feeling that this one will be quicker than the approach using Differences. – Kagaratsch Feb 14 '18 at 21:17
• Would go with this one though, to account for cyclic boundary: Length[SplitBy[Sign[list], Sign]] - 1 + Abs[Sign[list[[1]]] - Sign[list[[-1]]]]/2 – Kagaratsch Feb 14 '18 at 21:23
• Note that my flipNum[list] returns 6, since the sign flip between first and last list element also counts. – Kagaratsch Feb 14 '18 at 21:29
• Thank you for the timing comparison! On my machine, adding Abs[Sign[list[[1]]] - Sign[list[[-1]]]]/2 to Chip Hurst's answer to account for the possible difference due to cyclicity does not make it slower. Will accept his answer as the most efficient one. – Kagaratsch Feb 14 '18 at 22:48
• Observe that built-in function SequenceCount is obnoxiously slow: builtin = SequenceCount[#, {-1, 1} | {1, -1}, Overlaps -> True] &; This is an example where using a built-in function that performs your task is not advisable! – QuantumDot Feb 15 '18 at 0:19

For fun:

Needs["LinearAlgebraBLAS"]

l2 = RotateRight[list];
AXPY[1, list, l2];
AbsoluteTiming[Length[list] - Total[Unitize@l2]]

(*{0.0435857, 5000678}*)

• Nice one! Unfortunately, when I wrap all three lines in AbsoluteTiming, it becomes just as quick as the accepted answer. – Kagaratsch Feb 14 '18 at 23:36
• Oh duh! I knew I was cheating somehow.... – chuy Feb 15 '18 at 0:02
• chuy, i don't have the LinearAlgebraBLAS package so I could not include this in the timing comparisons. Please feel free to add this to the table in my post. (+1) – kglr Feb 15 '18 at 1:17
• oh its waaay slower. – chuy Feb 15 '18 at 15:45
Count[ ListConvolve[{1, 1}, list,1], 0]

• Nice. You can avoid using Count with Length[list] - Total[Abs[ListConvolve[{1, 1}, list, 1]]]/2. – Chip Hurst Feb 15 '18 at 17:57
• @ChipHurst i tried evaluating the timing and with your suggestion it became 35% faster. – Alucard Feb 15 '18 at 18:08

Another approach using Count,

Count[list+ RotateRight @ list,0]


6

Update

This version seems to be much faster. Credits to Chip Hurst.

Length[#] - Total[Abs[# + RotateRight@#]]/2 & [list]


6

flips = With[{q = Split[Positive[#]][[All, 1]]},
Length[q] - Boole[First[q] === Last[q]]] &;
flips[list]


6

works only if Length[list] >= 1 though

for a list of signs list={1,1,-1,1,-1,-1,1,1,1,-1}; the following code

With[{f = First[list], r = Rest[list]},
Block[{o},
If[f == r[[-1]], o = {0, f}, o = {1, f}];
First[
Fold[
With[{c = #1[[1]], s1 = #1[[-1]], s2 = #2},
If[
s1 == s2,
{c, s2},
{c + 1, s2}
]
] &, o, r]]]]


evaluates to

6


PS. The same result is produced by

-Total[Cases[Apply[Times, Partition[list, 2, 1, {1, 1}], 1], Except[1]]]

• Note that my flipNum[list] returns 6, since the sign flip between first and last list element also counts. – Kagaratsch Feb 14 '18 at 21:29

An approach for when you like to think your list has periodic boundary conditions

ProgressiveDifferences[list_] :=  Reverse[Differences[Reverse[list]]];
(* returns a list of x_i - x_{i+1} instead of  x_{i+1} - x_i given by Differences *)

WrappingDifferences[list_] := Append[ProgressiveDifferences[list], list[[Length[list]]] - list[[1]]]/2;
(* Difference gives an N-1 list, append the periodic boundary difference to that *)


Then

 q[list_] := Total[Abs[WrappingDifferences[list]]];


gives you the number of points where the signs disagree.