16
$\begingroup$

I have a list consisting of symbols and integers. I would like to delete the integers from the list only if a symbol precedes and follows each integer:

testList={a,b,3,c,4,5,d,e,f,1,g,4}

becomes:

resultList={a,b,c,4,5,d,e,f,g,4}

This is really a basic question and I almost didn't post it for that reason.

testList//.{a__,_Integer,b__}:>{a,b} 

gets rid of all the integers, not the desired result.

$\endgroup$
19
$\begingroup$

Try

testList //. {a___, aa_Symbol, _Integer, bb_Symbol, b___} :> {a, aa, bb, b}
{a, b, c, 4, 5, d, e, f, g, 4}
% == resultList
True

Note that I replaced __ (BlankSequence) with ___ (BlankNullSequence), so this will work for an integer which appears as the second element in the list.

$\endgroup$
  • $\begingroup$ Yes, I needed the triple underscore. Thanks! $\endgroup$ – Suite401 Oct 7 '17 at 5:45
  • 1
    $\begingroup$ You have my vote but FYI there is a better way to approach this style of replacement; please see my complementary answer. $\endgroup$ – Mr.Wizard Oct 7 '17 at 9:10
20
$\begingroup$

ReplaceRepeated is fine for short lists but it will get very slow if the list is long, because it starts over from the beginning of the list after each replacement. A better approach is to start the next replacement after the point of the previous one. One implementation of that:

fn1 = # /.
      {a___, aa_Symbol, _Integer, bb_Symbol, b___} :> 
        Join[{a, aa}, fn1 @ {bb, b}] &;

With jjc385's original as:

jjc = # //. {a___, aa_Symbol, _Integer, bb_Symbol, b___} :> {a, aa, bb, b} &;

Because my function is recursive I will need to raise $RecursionLimit for this benchmark.

$RecursionLimit = 1*^4;
big = RandomChoice[{1, 2, a, b, c, d}, 10000];

AbsoluteTiming[r1 = jjc[big];]
AbsoluteTiming[r2 = fn1[big];]

r1 === r2
{60.2394, Null}

{0.328343, Null}

True

Another example of this method:

A different method that might be of interest is SequencePosition, though it proves to be slower than fn1:

fn2 =
  Delete[#, 
    SequencePosition[big, {_Symbol, _Integer, _Symbol}][[All, {1}]] + 1] &;

AbsoluteTiming[r3 = fn2[big];]

r1 === r3
{1.35279, Null}

True

Performance Race

jjc385 challenged back with a method an order of magnitude faster than my own fn1 proposal. In reply, for the sake of performance tuning I shall make an assumption: that the list is entirely composed of Symbol and Integer expressions.

fn3 =
  Pick[
    #, 
    Unitize @ Subtract[ListCorrelate[{4, 2, 1}, Boole[IntegerQ /@ #], 2, 1], 2],
    1
  ] &;

Test:

big = RandomChoice[{1, 2, a, b, c, d}, 50000];

jjc2[big]; // RepeatedTiming
fn3[big];  // RepeatedTiming

fn3[big] === jjc2[big]
{0.112, Null}

{0.0153, Null}

True
$\endgroup$
  • $\begingroup$ You inspired me to improve, and somehow I beat you by an order of magnitude! (See my new answer.) This is at least the second time you've suggested an improvement on one of my ReplaceRepeated answers, and I greatly appreciate the comments. $\endgroup$ – jjc385 Oct 7 '17 at 11:14
  • 1
    $\begingroup$ @Mr.Wizard Your second solution is excellent. Thanks for sharing. $\endgroup$ – Anjan Kumar Oct 7 '17 at 13:21
18
$\begingroup$

Mr.Wizard inspired me to improve. While his recursive approach is elegant, the problem clearly can be done linearly. Indeed:

jjc2 = (
   Sow@First@#;
   BlockMap[ 
      If[ ! MatchQ[#, {_Symbol, _Integer, _Symbol}], Sow@#[[2]] ]; &,
      #, 3, 1 ];
   Sow@Last@big;
     // Reap 
    // Last@*Last
  ) &

(r1=jjc2@big); // AbsoluteTiming

{0.102811, Null}

Mr.Wizard's faster answer:

fn1 = # /.
      {a___, aa_Symbol, _Integer, bb_Symbol, b___} :> 
        Join[{a, aa}, fn1 @ {bb, b}] &;

Block[{$RecursionLimit = 1*^4}, (r2=fn1@big);] // AbsoluteTiming

{1.26777, Null}

r1 === r2
True

An order of magnitude? I'll take it! :)

$\endgroup$
  • 1
    $\begingroup$ Heh. Nicely done. If I have time I'll try to beat this. :-) $\endgroup$ – Mr.Wizard Oct 7 '17 at 11:39
  • $\begingroup$ @Mr.Wizard I'm counting on it! $\endgroup$ – jjc385 Oct 7 '17 at 11:40
  • $\begingroup$ Posted as an addendum to my answer. Please have a look. $\endgroup$ – Mr.Wizard Oct 7 '17 at 12:21
13
$\begingroup$

The slowest part of @MrWizard's solution is the conversion to 1s and 0s. Here is a faster way to do this conversion:

Boole[IntegerQ /@ big]; //RepeatedTiming
Replace[big, {_Integer->1, _->0}, {1}]; //RepeatedTiming

{0.018, Null}

{0.0051, Null}

Here is a slightly different approach to converting the 0|1 list to the desired output:

deleteSingletons[list_] := With[{boole = Replace[list, {_Integer->1, _->0}, {1}]},
    Pick[list, Ramp @ ListCorrelate[{-1, 1, -1}, boole, 2, 1], 0]
]

And a speed comparison:

r1 = fn3[big]; //RepeatedTiming
r2 = deleteSingletons[big]; //RepeatedTiming

r1 === r2

{0.020, Null}

{0.0070, Null}

True

$\endgroup$
  • $\begingroup$ Nice; I noticed that was the bottleneck in my code and intended to come back to it, but I see you already did. I wish there were optimized functions that returned a binary value rather than True and False since the latter cannot be packed. $\endgroup$ – Mr.Wizard Oct 7 '17 at 20:18
12
$\begingroup$
f0 = Flatten @ DeleteCases[{_Integer}] @ SplitBy[#, IntegerQ] &;

f0 @ testList

{a, b, c, 4, 5, d, e, f, g}

Timings between those of Mr.Wizard's fn3 and jjc385's jjc2:

i=1;
{#, First@RepeatedTiming[result[i++] = #2[big];]}&@@@ 
 Transpose[{{"jjc2","f0", "fn3"}, {jjc2, f0, fn3}}] // Grid // TeXForm

$\begin{array}{cc} \text{jjc2} & 0.027 \\ \text{f0} & 0.012 \\ \text{fn3} & 0.0045 \\ \end{array}$

Equal @@ (result /@ {1, 2, 3})

True

$\endgroup$
  • 2
    $\begingroup$ Fast, but simple enough to use in real life. Big +1 $\endgroup$ – jjc385 Oct 7 '17 at 18:28
  • 1
    $\begingroup$ Yeah, I wish I had been sharp enough to see this equivalent; it's very nice. Aside: I wish SplitBy had an operator form; I wonder why it does not. $\endgroup$ – Mr.Wizard Oct 7 '17 at 20:13
  • $\begingroup$ Thank you @Mr.Wizard. Re operator form for SplitBy, my first attempt was actually Composition[Flatten, DeleteCases[{_Integer}], SplitBy[IntegerQ]]:) $\endgroup$ – kglr Oct 7 '17 at 20:41
10
$\begingroup$

Another fast one:

fsw[x_] := Module[{r = Range@Length@x, i},
  i = Pick[r, x, _Integer];
  x[[Complement[r, Complement[i, i + 1, i - 1, r[[{1, -1}]]]]]]]
$\endgroup$
  • 3
    $\begingroup$ This one really nails down... You should also add timings for comparison... $\endgroup$ – ercegovac Oct 7 '17 at 20:08
8
$\begingroup$

Using a less drastic pattern tend to speed things up a bit, but not as much as jjc2

fn2 = Delete[#, Transpose[{Pick[Most[#], Differences[#], 2] + 1 &[
                 Position[#, _Symbol, Heads -> False][[All, 1]]]}]] &;
AbsoluteTiming[r2 = fn1[big];]
AbsoluteTiming[r3 = fn2[big];]
AbsoluteTiming[r4 = jjc2[big];]
r3 === r2 === r4

{1.0232561, Null}
{0.13014199, Null}
{0.085108557, Null}
True

$\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.