4
$\begingroup$

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.

$\endgroup$
3
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Fancier of Mathematica Aug 17 '14 at 18:59
  • $\begingroup$ Also important that I'm not creating list from a list. $\endgroup$ – Fancier of Mathematica Aug 17 '14 at 19:02
  • $\begingroup$ @Fan please see my updated answer. $\endgroup$ – Mr.Wizard Aug 18 '14 at 1:32
5
$\begingroup$

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} *)
$\endgroup$
  • $\begingroup$ this seems to most accurately implement what the text describes +1 $\endgroup$ – ubpdqn Aug 17 '14 at 12:01
  • 1
    $\begingroup$ @Artes The way I see it it's the only solution. $\endgroup$ – C. E. Aug 17 '14 at 15:15
  • $\begingroup$ Let's say we do so: Table[f[i],{i,1,10}], with some given function f. It might be Sin[i], Cos[i] and etc. I want to do so: if f[i]=0, then f[i+1],..,f[10]=0. Not checking whether f[i+1],..,f[10]=0. If, for example, f[1]>0, f[2]>0, but f[3]=0, then the result should be {f[1],f[2],0,0,0,0,0,0,0,0}. $\endgroup$ – Fancier of Mathematica Aug 17 '14 at 15:51
  • $\begingroup$ @Pickett Ok I provided another solution. $\endgroup$ – Artes Aug 17 '14 at 16:02
  • $\begingroup$ @FancierofMathematica With this solution you can do that, and also with the new solution by Artes. $\endgroup$ – C. E. Aug 17 '14 at 16:12
4
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ ... or Threshold[Range[10], {"Hard", 5}]. Pity that Treshhold doesn't find smallest values. Anyway, +1 $\endgroup$ – eldo Aug 17 '14 at 12:18
  • $\begingroup$ @eldo Thanks, it seems the OP asked for something else, thus I updated the anser. $\endgroup$ – Artes Aug 17 '14 at 16:05
  • $\begingroup$ 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]]] $\endgroup$ – C. E. Aug 17 '14 at 16:22
  • $\begingroup$ Perhaps TakeWhile[list, # != 5 &] // Join[#, {5}, ConstantArray[0, Length@list - Length@# - 1]] & so that list is not crawled twice. $\endgroup$ – seismatica Aug 17 '14 at 19:26
  • $\begingroup$ 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 $\endgroup$ – seismatica Aug 17 '14 at 19:54
2
$\begingroup$

The simplest code I can think of is:

Range@10 /. (x_ /; x > 5 :> 0)
{1, 2, 3, 4, 5, 0, 0, 0, 0, 0}
$\endgroup$
  • $\begingroup$ Thank You. It's simple when you know :) $\endgroup$ – Fancier of Mathematica Aug 17 '14 at 11:27
1
$\begingroup$
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} *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.