# Use Mathematica to split a sequence according to other two sequences

I want to use Mathematica to solve the following problem:

For example I have a sequence 101. I want to compare it with $$1101$$ and $$0101$$. The comparison has the following procedure:

1. Check the first term of $$101$$ is $$1$$ or $$0$$. If it is $$1$$, compare $$101$$ to $$1101$$, term by term; If it is $$0$$, compare $$101$$ to $$0101$$. Stop the process before the first term they are different, or all the terms of $$101$$ have been compared without stopping the process, and report all the terms that have been compared.

In our case, the first term of $$101$$ is $$1$$, so we compare it with $$1101$$. Then, $$101$$ and $$1101$$ only has one term in common, the first term $$1$$. So the program should report $$1$$, and go to next step.

1. Recording the remaining sequence of $$101$$.

In our case, as only $$1$$ is reported, the remaining sequence is $$01$$.

1. Restart the process. Check the first term of $$01$$ is $$0$$ or $$1$$. If it $$0$$, compare $$01$$ with $$0101$$, if it is $$1$$, compare $$01$$ with $$1101$$. Stop the process before the first term they are different, or the sequence of $$01$$ has been run out. Report all the timers that have been compared.

*In our case, the first term of $$01$$ is $$0$$, so we compare $$01$$ with $$0101$$. Then the first two terms agree, and then $$01$$ ran out. The program should report $$01$$, and then stop.

1. Repeating the process again and again until there is no remaining sequence.

I tried to use the commend "If" to write this but it did not work, since I did not know how to let Mathematica to "remember" what has been compared.

Then, I tried to use commend "Order" and "Sort", but it seems that I need to program a comparison function.

Is there anyway for me to achieve this using Mathematica? Thank you!

Update: We can use Split to get the desired result in a single step:

ClearAll[sPlit]
sPlit[s0_, s1_][s_] := Module[{ref, x = Characters @ s},
ref["0"] = Characters @ s0;
ref["1"] = Characters @ s1;
Module[{i = 0, rf = ref[x[[1]]]},
StringJoin /@ Split[x, Or[{##} == rf[[{i++, i}]], i = 1; rf = ref[#2]] &]]]


Examples:

sPlit["0101", "1101"]["101"]

 {"1", "01"}

sPlit["010111010", "110111010"]["10111010"]

 {"1", "01", "1101", "0"}

sPlit[s0, s1][s] (* s, s0, s1 from the original answer below *)

 {"0", "1", "1", "101", "001", "0", "101", "0", "1"}


ClearAll[lW, tD, steP, fP]

lW[l0_, l1_][x_] := LengthWhile[Range @ Length @ x,
x[[#]] == l0[[#]] || x[[#]] == l1[[#]] &]

tD[l0_, l1_][x_] := TakeDrop[x, lW[l0, l1][x]]

steP[l0_, l1_][{a___, b_List /; Length[b] > 0}] := {a, ## & @@ tD[l0, l1][b]}

steP[l0_, l1_][a : {___, {}}] := a

fP[s0_String, s1_String][s_String] := Module[{c = Characters /@ {s0, s1, s}},
StringJoin /@ Most[FixedPoint[steP[c[[1]], c[[2]]], {c[[3]]}]]]


Examples:

fP["0101", "1101"]["101"]

 {"1", "01"}

fP["010111010", "110111010"]["10111010"]

{"1", "01", "1101", "0"}

SeedRandom[123]
s = RandomChoice[{"0", "1"}, 15];

{s, s0, s1} = StringJoin /@ {s, Prepend["0"]@s, Prepend["1"]@s}

{"011101001010101", "0011101001010101", "1011101001010101"}

fP[s0, s1][s]

{"0", "1", "1", "101", "001", "0", "101", "0", "1"}

• OMG. Nice answer!!! Nov 14 '20 at 15:06

Split the string:

a = StringSplit["101", ""]
b = StringSplit["1101", ""]


Get the large position by using NestWhile:

maxPos = NestWhile[# + 1 &, 1, a[[#]] == b[[#]] &] - 1


1

a[[1 ;; maxPos]]


{"1"}

The remaining items:

Take[a, Length@a - maxPos]


{"1", "0"}

Then Get the large position by using NestWhile:, repeat it.

I'll leave the left to you :)

• Thank you so much! And thank you for reading my long post :)) Brilliant code Nov 14 '20 at 15:05