7
$\begingroup$

I have a series of lists of this form: {1, 1, 1, 1, 0, 0, 1, 1}. I would like to perform a survival analysis on these lists. To do that, I need a code that would check each elements of these lists, do nothing as long as these are 1s, but as soon as one element is 0, it would change all the following elements to zero.

As an example, this code would transform the above list to {1, 1, 1, 1, 0, 0, 0, 0}. I can't seem to find a way to do this. Thanks.

Improve this question
$\endgroup$

6 Answers 6

Reset to default
6
$\begingroup$

Let's take

list = {{1, 1, 1, 0, 1, 0, 1}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 1, 1, 1}, {0, 0}}

and run

list /. {x : 1 ___, z : 0 ___, y___} :> PadRight[{x}, Length@{x, z, y}]

{{1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0}, {0, 0}}

Original answer:

Cases[list, {x : 1 ___, 0, y___} :> PadRight[{x}, Length @ {x, 0, y}]]

{{1, 1, 1, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0}, {0, 0}}

Equivalents:

Cases[list, {x : 1 ___, 0, y___} :> Flatten @ {x, 0, ConstantArray[0, Length @ {y}]}]

Cases[list, {x : 1 ___, 0, y___} :> Join @@ {{x}, {0}, ConstantArray[0, Length @ {y}]}]

Fails when a list is composed only of 1s.

UPDATE:

This is a fix:

Cases[list, {Longest[x : 0 .. | 1 ..], y___} :> PadRight[{x}, Length @ {x, y}]]
Improve this answer
$\endgroup$
7
  • $\begingroup$ Thanks a lot, works great. So 1___ is the part of the list that is composed of successive 1s? $\endgroup$ Commented Oct 26, 2016 at 17:44
  • 1
    $\begingroup$ 1___ is a pattern saying to take the initial 1s in the list; the three underscores ___ indicate to take as many (initial) 1s there are, including the case when there are no 1s in the beginning. Two underscores, __ would indicate as many 1s there are but at least one, so it would fail to return the proper answer in the case of list[[3]]. $\endgroup$ Commented Oct 26, 2016 at 17:51
  • $\begingroup$ Just as a curio: to get all succesive 1 see here. $\endgroup$ Commented Oct 26, 2016 at 18:07
  • $\begingroup$ I'm not sure but, I think there might be a problem with the solution that you proposed. I had initially 137 lists, but when I apply your function I only get 103 as output. It is important that I keep the same number of sublists at the end. Would you know how to correct that? $\endgroup$ Commented Oct 26, 2016 at 18:41
  • 1
    $\begingroup$ I edited accordingly; provided a different, working, method. $\endgroup$ Commented Oct 26, 2016 at 19:03
8
$\begingroup$

Edit

As kglr points out in a comment:

FoldList[Times]/@list

Original Answer

FoldList[Times, #] & /@ list

{{1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0}, {0, 0}}

Improve this answer
$\endgroup$
2
  • $\begingroup$ (+1) You could also use the operator form FoldList[Times]/@list. $\endgroup$ Commented Oct 26, 2016 at 19:27
  • $\begingroup$ @kglr Thanks! Have added your code to the answer. $\endgroup$ Commented Oct 26, 2016 at 19:34
1
$\begingroup$

Using PositionSmallest (new in V 13.2)

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

MapAt[0 &, First @ PositionSmallest @ list ;;] @ list

{1, 1, 1, 1, 0, 0, 0, 0}

Or, more generally,

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

MapAt[Min @ list &, First @ PositionSmallest @ list ;;] @ list

{2, 2, 2, 2, 1, 1, 1, 1}

Improve this answer
$\endgroup$
1
$\begingroup$

Define a function that changes its definition when it encounters a 0 and map it on the input list:

ClearAll[f]
f[list_, v_ : 0, nv_ : 0] := 
 Module[{$f}, $f[x_] := x; $f[v] := $f[_] = nv; Map[$f] @ list]

Examples:

lists = {{1, 1, 1, 0, 1, 0, 1}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 1, 1, 1}, {0, 0}}

f /@ lists

{{1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0}, {0, 0}}

f[#, 0, 5] & /@ lists

{{1, 1, 1, 5, 5, 5, 5}, {1, 1, 1, 1, 1, 1, 1, 1}, {5, 5, 5, 5}, {5   5}}
Improve this answer
$\endgroup$
1
$\begingroup$ 
ClearAll[h]

h[v_ : 0, nv_ : 0] := SequenceReplace[p : {v, ___} :> Splice[nv & /@ p]];

Examples:

lists = {{1, 1, 1, 0, 1, 0, 1}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 1, 1, 1}, {0, 0}};

h[] /@ lists

{{1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0}, {0, 0}}

h[0, 5] /@ lists

{{1, 1, 1, 5, 5, 5, 5}, {1, 1, 1, 1, 1, 1, 1, 1}, {5, 5, 5, 5}, {5, 5}}

WolframLanguageData["SequenceReplace", {"VersionIntroduced",  "DateIntroduced"}]

enter image description here

Improve this answer
$\endgroup$
0
$\begingroup$

Essentially picking an entry from the lower triangularized matrix t.

Clear["Global`*"];
lists = {{1, 1, 1, 0, 1, 0, 1}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 1, 1, 
    1}, {0, 0}};

survival[k_List] := 
 Module[{t = 
    SparseArray[{{i_, j_} /; i >= j -> 1}, {Length@k, Length@k}]
   , fp0 = First[FirstPosition[k, 0, 0], Length@k + 1]
   },
  If[k[[1]] == 0, ConstantArray[0, Length@k], t[[-1 + fp0]] // Normal]
  ]

survival /@ lists

{{1, 1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 1, 1, 1, 1}, {0, 0, 0, 0}, {0,
0}}

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.