# The position of some lists in a list

I have a list of lists:

list = {{0, 0, 0, 0}, {1, 1, 0, 0}, {2, 1, 1, 0}, {3, 1, 1, 1}, {1, 1, 1, 1}, {2, 2, 2, 0}, {2, 2, 1, 1}, {3, 2, 2, 1}, {2, 2, 2, 2}, {3, 3, 2, 2}, {3, 3, 3, 3}}


I want a list of the positions at which the lists containing no 1's occur. For the above I want: {1,6,9,10,11}.

I have tried Position[list, x_/;Count[x,1]==0 &] but it didn't work.

This counts how many 1's are in each sublist, and then finds the position of all those with zero count. With list equal to your list:

Position[Count[#, 1] & /@ list, 0] // Flatten

{1, 6, 9, 10, 11}


Also:

ClearAll[f1, f2, f3]
f1 = MapIndexed[If[FreeQ[#, 1], #2[[1]], ## &[]] &, #] &;
f2 = Pick[Range@Length@#, Times @@@ Unitize[# - 1], 1] &;
f3 = Flatten@Position[Times @@@ Unitize[# - 1], 1] &;

f1@list


{1, 6, 9, 10, 11}

Equal @@ (#[list] & /@ {f1, f2, f3} )


True

A logical approach:

Flatten @ Position[#, 0] & @ (Boole @ MemberQ[#, 1] & /@ list)


or

Flatten @ Position[#, 1] & @ (Boole @ Not @ MemberQ[#, 1] & /@ list)


{1, 6, 9, 10, 11}

The first is a bit shorter, but in the second you keep picking "true" statements (due to the Not), so it might be cenceptually simpler.

Regarding your own approach, i.e. Position[list, x_/;Count[x,1]==0 &], it's almost right. You mixed patterns and functions. It will work if you delete the & sign and specify the level in Position to be 1:

Flatten @ Position[list, x_ /; Count[x, 1] == 0, 1]


{0, 1, 6, 9, 10, 11}

Note, however, that you obtain an unnecessary 0 too.

Additionally, an approach with Cases:

Position[list, #] & /@
Cases[list, s_ /; MemberQ[s, 1] == False] // Flatten


{1, 6, 9, 10, 11}

Rest@Position[list, a_List /; FreeQ[a, 1], {1}]
Flatten@Rest@Position[list, Except[{___, 1, ___}], {1}]


(So that it doesn't get lost, Bob Hanlon's variation:)

Rest@Flatten@Position[list, _?(FreeQ[#, 1] &), 1]

• Rest@Flatten@Position[list, _?(FreeQ[#, 1] &), 1] Commented Sep 26, 2016 at 23:06
list = {{0, 0, 0, 0}, {1, 1, 0, 0}, {2, 1, 1, 0}, {3, 1, 1, 1}, {1, 1,
1, 1}, {2, 2, 2, 0}, {2, 2, 1, 1}, {3, 2, 2, 1}, {2, 2, 2, 2}, {3,
3, 2, 2}, {3, 3, 3, 3}}

ContainsNone[{1}] /@ list // Position[#, True] & // Flatten

Position[list, _?(ContainsNone[{1}]), 1] // Flatten

list // Map[FreeQ[#, 1] &] // Position[True] // Flatten

list // Map[FreeQ[1]] // Position[True] // Flatten

SequenceCases[#, {___, 1, ___}] & /@ list // Position[{}] // Flatten

Position[list, {OrderlessPatternSequence[Except[1] ..]}, 1] // Flatten

Counts /@ list // Map[#[1] &] // Position[_Missing] // Flatten

list // Map[Count[#, 1] &] // Position[0] // Flatten

FirstPosition[#, 1, x] & /@ list // Position[x] // Flatten


Result:

{1, 6, 9, 10, 11}

list = {{0, 0, 0, 0}, {1, 1, 0, 0}, {2, 1, 1, 0}, {3, 1, 1, 1},
{1, 1, 1, 1}, {2, 2, 2, 0}, {2, 2, 1, 1}, {3, 2, 2, 1},
{2, 2, 2, 2}, {3, 3, 2, 2}, {3, 3, 3, 3}};


Using DeleteCases and Position:

patt = Alternatives @@ Permutations[{1, __, _}];

DeleteCases[list, patt] // Map[Position[list, #] &] // Flatten


Result:

{1, 6, 9, 10, 11}

Or using ReplaceList:

patt = {___, s : {OrderlessPatternSequence[Except[1] ..]}, ___} :> s;

ReplaceList[list, patt] // Map[Position[list, #] &] // Flatten


Result:

{1, 6, 9, 10, 11}

list =
{{0, 0, 0, 0}, {1, 1, 0, 0}, {2, 1, 1, 0}, {3, 1, 1, 1},
{1, 1, 1, 1}, {2, 2, 2, 0}, {2, 2, 1, 1}, {3, 2, 2, 1},
{2, 2, 2, 2}, {3, 3, 2, 2}, {3, 3, 3, 3}};

Flatten @ Position[list, Alternatives @@ GroupBy[list, FreeQ @ 1][True]]


{1, 6, 9, 10, 11}