6

I'm trying to create a conditional table. Let's say I want to have such result: {1,2,3,4,5,0,0,0,0,0}.

The idea is to create a table of n elements (10 in a given example), but when one element takes a specific value (5 in my example), then all of the remaining elements must take provided value (let's say zero).

It's important not to use IF checking every element whether it satisfies provided condition.

8 Answers8

7

This is a more general pattern solution that doesn't require each value after five to be larger than five:

list = {9, 4, 9, 1, 2, 9, 5, 4, 4, 6};
list /. {a___, 5, b___} :> {a, 5, Sequence @@ ConstantArray[0, Length@{b}]}
(* Out: {9, 4, 9, 1, 2, 9, 5, 0, 0, 0} *)
C. E.
  • 70,533
  • 6
  • 140
  • 264
5

The simplest code I can think of is:

Range@10 /. (x_ /; x > 5 :> 0)
{1, 2, 3, 4, 5, 0, 0, 0, 0, 0}
Öskå
  • 8,587
  • 4
  • 30
  • 49
5

This solves the problem as it has been posed:

list = {1, 2, 3, 7, 9, 11, 5, 3, 5, 9};

Join[ TakeWhile[ list, # != 5 &], {5}, 
      ConstantArray[0, Length[list] - FirstPosition[ list, 5]]]
{1, 2, 3, 7, 9, 11, 5, 0, 0, 0}

In case the list consitst of consecutive elements:

Range @ 10 // # UnitStep[5 - #]&
{1, 2, 3, 4, 5, 0, 0, 0, 0, 0}

If we are to find larger values we can use Threashold

Threshold[ Range @ 10, {"LargestValues", 5}]
{0, 0, 0, 0, 0, 6, 7, 8, 9, 10}
Artes
  • 57,212
  • 12
  • 157
  • 245
  • ... or Threshold[Range[10], {"Hard", 5}]. Pity that Treshhold doesn't find smallest values. Anyway, +1 – eldo Aug 17 '14 at 12:18
  • @eldo Thanks, it seems the OP asked for something else, thus I updated the anser. – Artes Aug 17 '14 at 16:05
  • I haven't benchmarked it but it looks costly to evaluate both FirstPosition and TakeWhile, another option: With[{fp = First@FirstPosition[list, 5]}, Join[list[[1 ;; fp]], ConstantArray[0, Length@list - fp]]] – C. E. Aug 17 '14 at 16:22
  • Perhaps TakeWhile[list, # != 5 &] // Join[#, {5}, ConstantArray[0, Length@list - Length@# - 1]] & so that list is not crawled twice. – seismatica Aug 17 '14 at 19:26
  • Clear[f1, f2, listTest]; listTest = Range[1, 10, 0.0001]; f1[list_, n_] := Join[TakeWhile[list, # != n &], {n}, ConstantArray[0, Length[list - FirstPosition[list, n]]]] // AbsoluteTiming // First; f2[list_, n_] := TakeWhile[list, # != n &] // Join[#, {n}, ConstantArray[0, Length@list - Length@# - 1]] & // AbsoluteTiming // First; Mean@Table[#[listTest, 5] & /@ {f1, f2}, {10}] screenshot – seismatica Aug 17 '14 at 19:54
4

You wrote:

It's important not to use IF checking every element whether it satisfies provided condition.

I cannot agree with this, unless you mean that once the sought element is found the rest of the elements should not be checked (possibly) using If. What I mean is that even if not using If itself there is going to be some kind of by-element checking until the target value is found.

One approach to what I believe you want:

SeedRandom[0]
a = RandomInteger[9, 10]
{7, 0, 8, 2, 1, 5, 8, 0, 6, 7}
p = FirstPosition[a, 5][[1]]

Join[Take[a, p], ConstantArray[0, Length@a - p]]
{7, 0, 8, 2, 1, 5, 0, 0, 0, 0}

Or more concise but less efficient:

Join[Take[a, p], 0 Drop[a, p]]
{7, 0, 8, 2, 1, 5, 0, 0, 0, 0}

Update

Based on your comments I believe this should be of use to you:

cTable[f_, n_] := FoldList[If[# == 0, 0, f @ #2] &, f @ 1, 2 ~Range~ n]

Example:

f = Mod[2 # + 1, 9] &;

cTable[f, 10]
{3, 5, 7, 0, 0, 0, 0, 0, 0, 0}

Note that f is only called four times here, not once for each element in the output. As proof we can add a Pause to it:

f = (Pause[1]; Mod[2 # + 1, 9]) &;

cTable[f, 10] // AbsoluteTiming
{4.010006, {3, 5, 7, 0, 0, 0, 0, 0, 0, 0}}

Because FoldList auto-compiles (by default for lists 100 or longer) this method should be acceptably fast. For example a list with nearly 5,000,000 zeros takes only a fraction of a second on my machine:

cTable[Mod[2 # + 1, 9] &, 5000000]; // AbsoluteTiming
{0.360001, Null}
Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
  • Yes, it's important not to check every element. I'm trying to create such table: Table[f[i],[i,1,N]]. The function f[i] is complicated and it takes long time to calculate it's value. However I know that if it takes the first value 0 as "i" varies from 1 to N, then the next values of it is also zero. If f[3]=0, then the result should be {f[1],f[2],0,..,0} - N elments in the list. – Fancier of Mathematica Aug 17 '14 at 18:59
  • Also important that I'm not creating list from a list. – Fancier of Mathematica Aug 17 '14 at 19:02
  • @Fan please see my updated answer. – Mr.Wizard Aug 18 '14 at 01:32
4
ClearAll[f1, f2, f3, f4];
list = {1, 2, 3, 7, 9, 11, 5, 3, 5, 9};

SetAttributes[f1, {Listable}]
(* redefine f1 to 0& when an input with value t is processed: *)
f1[t_, x_] := Piecewise[{{f1 = 0 &; x, x == t}}, x] 
f1[5 , list]
(* {1,2,3,7,9,11,5,0,0,0} *)

f2 = MapAt[0 &, #2, {1 + Position[#2, #1, 1, 1][[1, 1]] ;;}] &;
f2[5, list]
(* {1,2,3,7,9,11,5,0,0,0} *)

f3 = Function[{t, lst}, 
      Module[{ca = ConstantArray[0, {Length@lst}], 
        lw = ;; 1 + LengthWhile[lst, # != t &]}, ca[[lw]] = lst[[lw]]; ca]];
f3[5, list]
(* {1,2,3,7,9,11,5,0,0,0} *)

f4 = Function[{t, lst}, Module[{splt = Split[lst, # != t &]}, 
            splt[[2 ;;]] = 0 splt[[2 ;;]]; Join @@ splt]];
f4[5, list]
(* {1,2,3,7,9,11,5,0,0,0} *)
kglr
  • 394,356
  • 18
  • 477
  • 896
1
list = Range[10];

1.

I think the operator form of MapAt with Span syntax wasn't available at the time the question was posed.

MapAt[0 &, 6 ;;] @ list

{1, 2, 3, 4, 5, 0, 0, 0, 0, 0}

2.1

V 13.1 introduced ReplaceAt

ReplaceAt[list, _ :> 0, 6 ;;]

{1, 2, 3, 4, 5, 0, 0, 0, 0, 0}

2.2

ReplaceAt has the advantage that we can easily impose conditions:

list = {1, 2, 3, 4, 5, 6, "a", "b", 9, 10};

ReplaceAt[list, _?NumericQ :> 0, 6 ;;]

{1, 2, 3, 4, 5, 0, "a", "b", 0, 0}

eldo
  • 67,911
  • 5
  • 60
  • 168
1

Using MapIndexed:

Clear["Global`*"];
SeedRandom[1];
list = RandomInteger[{1, 10}, 20]

{2, 5, 1, 8, 1, 1, 9, 7, 1, 5, 2, 9, 6, 2, 2, 2, 4, 3, 2, 7}

condTable[k_List, n_, repl_ : 0] :=
 MapIndexed[
  If[First@#2 > First@FirstPosition[k, n, {Length@k}], repl, #] &, k
  ]

Usage:

condTable[list, 55, x]   (* not in list case *)

{2, 5, 1, 8, 1, 1, 9, 7, 1, 5, 2, 9, 6, 2, 2, 2, 4, 3, 2, 7}

condTable[list, 4, x]

{2, 5, 1, 8, 1, 1, 9, 7, 1, 5, 2, 9, 6, 2, 2, 2, 4, x, x, x}

condTable[list, 9, g]

{2, 5, 1, 8, 1, 1, 9, g, g, g, g, g, g, g, g, g, g, g, g, g}

condTable[list, 7]      (* default case *) 

{2, 5, 1, 8, 1, 1, 9, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}


Using SequenceReplace:

Clear["Global`*"];
SeedRandom[1];
list = RandomInteger[{1, 10}, 20];
condTableSeqRep[k_List, n_, repl_ : 0] :=
 SequenceReplace[k, {
   {a___Except[n] ..} :>  {a}
   , {a___, n, b___} :> 
    Sequence @@ {a, n, Sequence @@ Table[repl, Length@{b}]}
   }
  ]

condTableSeqRep[list, 55, x] (* not in list case ) condTableSeqRep[list, 4, x] condTableSeqRep[list, 9, g] condTableSeqRep[list, 7] ( default case *)


(* same results *)

Syed
  • 52,495
  • 4
  • 30
  • 85
0
f[n_/;n >5]:=0
f[n_]:= n

Table[f[i],{i,1,10}]

(* {1,2,3,4,5,0,0,0,0,0} *)
user1066
  • 17,923
  • 3
  • 31
  • 49