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

10 Answers 10

21
$\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$
2
  • $\begingroup$ Yes, I needed the triple underscore. Thanks! $\endgroup$
    – Suite401
    Oct 7, 2017 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, 2017 at 9:10
22
$\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$
2
  • $\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, 2017 at 11:14
  • 1
    $\begingroup$ @Mr.Wizard Your second solution is excellent. Thanks for sharing. $\endgroup$ Oct 7, 2017 at 13:21
20
$\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$
3
  • 1
    $\begingroup$ Heh. Nicely done. If I have time I'll try to beat this. :-) $\endgroup$
    – Mr.Wizard
    Oct 7, 2017 at 11:39
  • $\begingroup$ @Mr.Wizard I'm counting on it! $\endgroup$
    – jjc385
    Oct 7, 2017 at 11:40
  • $\begingroup$ Posted as an addendum to my answer. Please have a look. $\endgroup$
    – Mr.Wizard
    Oct 7, 2017 at 12:21
16
$\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$
1
  • $\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, 2017 at 20:18
15
$\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$
3
  • 2
    $\begingroup$ Fast, but simple enough to use in real life. Big +1 $\endgroup$
    – jjc385
    Oct 7, 2017 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, 2017 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, 2017 at 20:41
12
$\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$
1
  • 3
    $\begingroup$ This one really nails down... You should also add timings for comparison... $\endgroup$
    – ercegovac
    Oct 7, 2017 at 20:08
10
$\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$
4
$\begingroup$

Not a candidate in the speed category, but readable.

list = {a, b, 3, c, 4, 5, d, e, f, 1, g, 4};
SequenceReplace[list, {a_Symbol, n_Integer, b_Symbol} :> 
  Sequence @@ {a, b}]

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

$\endgroup$
2
$\begingroup$
list = {a, b, 3, c, 4, 5, d, e, f, 1, g, 4};

Delete[
 list,
 Cases[
  Partition[MapIndexed[{##} &] @ list, 3, 1],
  {{_Symbol, _}, {_Integer, x_}, {_Symbol, _}} :> x]]

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

$\endgroup$
1
$\begingroup$

Using SequenceCases and DeleteElements:

lst = {a, b, 3, c, 4, 5, d, e, f, 1, g, 4};
res = {a, b, c, 4, 5, d, e, f, g, 4};
DeleteElements[lst, SequenceCases[lst, {a_Symbol, b_Integer, c__Symbol} :> b]] === res

(*True*)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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